ms advanced basic draw

[charles]

anyone at anytime ever get bored and did a port to atari for the ibm basic commad draw...
its the one where u feed a large string that contains graphic x y,
color...scale angle info

like this "a000 s10 c2 bm100,40 d45 l10 r4 u7"


ive begun but before i shoot myself in the foot just checking out here

[charles]

prob like logo

but not reading ..noway...
utilize electronic resources first...

[dje]

Here is my Draw procedure for OMIKRON BASIC. The GFA Basic Donkey code I ported also contained a Draw procedure, but that didn't include rotations.
Should be relatively easy to port this back to GFA. Note: VARPTR( MOUSEX )+$25A returns the Linea variable. The same as L~A in GFA
EDIT: All variables are 32 bit ints: ie: DEFINTL "A-Z" in OMIKRON.

Code: Select all

 
 DEF PROC Draw(A$)
   LOCAL A,B,X,Xx,Y,Yy,Is_R,Is_B,Is_T,Is_N,C$
   IF Draw_S=0 THEN
     A= VARPTR( MOUSEX )+$25A
     Draw_X= WPEEK(A-$C) SHL 7
     Draw_Y= WPEEK(A-$4) SHL 7
     Draw_Matrix(0,4)
   ENDIF
   FOR A=1 TO LEN(A$) STEP 0
     WHILE MID$(A$,A,1)=" ":A=A+1: WEND
     C$= UPPER$( MID$(A$,A,1)):A=A+1
     Is_N=C$="N": IF Is_N THEN C$= UPPER$( MID$(A$,A,1)):A=A+1
     Is_B=C$="B": IF Is_B THEN C$= UPPER$( MID$(A$,A,1)):A=A+1
     Is_T=C$="T": IF Is_T THEN C$= UPPER$( MID$(A$,A,1)):A=A+1
     IF LEN(C$) THEN
       WHILE MID$(A$,A,1)=" ":A=A+1: WEND
       Is_R= INSTR("_+-", MID$(A$,A,1))>1
       B=A: WHILE INSTR("_+-0123456789", MID$(A$,A,1))>1:A=A+1: WEND
       Xx= VAL( MID$(A$,B,A-B))
       WHILE MID$(A$,A,1)=" ":A=A+1: WEND
       IF MID$(A$,A,1)="," THEN A=A+1
       WHILE MID$(A$,A,1)=" ":A=A+1: WEND
       B=A: WHILE INSTR("_+-0123456789", MID$(A$,A,1))>1:A=A+1: WEND
       Yy= VAL( MID$(A$,B,A-B))
       X=Draw_X:Y=Draw_Y
       IF C$="C" THEN
         LINE COLOR =Xx:Is_B=-1
       ELSE IF C$="S" THEN
         Draw_Matrix(Draw_A,Xx):Is_B=-1
       ELSE IF C$="A" THEN
         IF Is_T THEN
           Draw_Matrix(Xx,Draw_S)
         ELSE
           Draw_Matrix(Xx*90,Draw_S)
         ENDIF
         Is_B=-1
       ELSE IF C$="M" THEN
         IF Is_R THEN
           Draw_X=Draw_X+(Xx SHL 8)*Draw_S\4
           Draw_Y=Draw_Y+(Yy SHL 8)*Draw_S\4
         ELSE
           Draw_X=Xx SHL 8
           Draw_Y=Yy SHL 8
         ENDIF
       ELSE
         IF INSTR("UEH",C$) THEN
           Draw_X=Draw_X-(Xx*Draw_00+Yy*Draw_01)
           Draw_Y=Draw_Y-(Xx*Draw_10+Yy*Draw_11)
         ENDIF
         IF INSTR("DFG",C$) THEN
           Draw_X=Draw_X+(Xx*Draw_00+Yy*Draw_01)
           Draw_Y=Draw_Y+(Xx*Draw_10+Yy*Draw_11)
         ENDIF
         IF INSTR("LGH",C$) THEN
           Draw_X=Draw_X+(Yy*Draw_00-Xx*Draw_01)
           Draw_Y=Draw_Y+(Yy*Draw_10-Xx*Draw_11)
         ENDIF
         IF INSTR("REF",C$) THEN
           Draw_X=Draw_X-(Yy*Draw_00-Xx*Draw_01)
           Draw_Y=Draw_Y-(Yy*Draw_10-Xx*Draw_11)
         ENDIF
       ENDIF : ENDIF : ENDIF : ENDIF
       IF NOT Is_B THEN
         DRAW LOW(X SHR 8), LOW(Y SHR 8) TO LOW(Draw_X SHR 8), LOW(Draw_Y SHR 8)
       ENDIF
       IF Is_N THEN Draw_X=X:Draw_Y=Y
     ENDIF
   NEXT A
 RETURN
 
 DEF PROC Draw_Matrix(A,B)
   Draw_A=A:Draw_S=B
   Draw_00= SIN(Draw_A* PI /180)*Draw_S*64
   Draw_01= COS(Draw_A* PI /180)*Draw_S*64
   Draw_10=Draw_01
   Draw_11=-Draw_00
 RETURN
 

[charles]

anxious to try yours
certain yours is compliant to the "A,S,B,N,U,D,L,R,C" etc etc of Microsoft basic ???
haven't tried yet.
but didn't see "p" for paint...fill

what is the "ueh,dfg,lgh,ref" identifyiers?
...grouped because same response invoked?



6361134_BASIC_Reference_3.0_May84.pdf

here is in past12hrs what I been working up.

Code: Select all

' sof
'
' * Almost compliant with 'DRAW' command
' * 6361134_BASIC_Reference_3.0_May84.pdf
'
LIST "a:\ibmdraw2.lst"
'
staff$="S10 A000 BM0,0 C2 "
staff$=staff$+"D8 R1 U8 L1 R1 BR40 "
staff$=staff$+"D8 R1 U8 L1 "
staff$=staff$+"L40 D2 R40 D2 L40 D2 R40 D2 L40 "
staff$=staff$+"L1 D16 R1 U8 L1 R1 BR40 "
staff$=staff$+"D8 R1 U8 L1 "
staff$=staff$+"L40 D2 R40 D2 L40 D2 R40 D2 L40 "
'
CLS
@draw(staff$)
END
'
> FUNCTION sift$(a$,b$,c$,VAR i&)
LOCAL aa$,az$
FOR i&=i& TO l&
  az$=UPPER$(MID$(a$,i&,1))
  EXIT IF az$<b$ OR az$>c$
  aa$=aa$+az$
NEXT i&
RETURN aa$
DEC i&
ENDFUNC
> PROCEDURE draw(a$)
LOCAL i&,l&,scale,tangle&,angle&,color&
'
LOCAL ax&,ay&,aw&,ah&,aaa&
'
l&=LEN(a$)
FOR i&=1 TO l&
  '
  xx$=FN sift$(a$,"A","Z",i&)
  ' PRINT AT(1,10);USING "!",xx$;
  '
  SELECT xx$
    '
    ' *******************
    ' **SETTING COMMANDs
    ' *******************
  CASE "S"
    scale=VAL(FN sift$(a$,"0","9",i&))
    '      PRINT AT(1,11);USING "scale ###",scale;
    DIV scale,4
    '
  CASE "C" !COLOR
    color&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "color ###",color&;
    '    '
  CASE "A" !ANGLE 0-360
    angle&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "angle ###",angle&;
    '
  CASE "T" !TURN ANGLE  ("TA")
    tangle&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "Tangl ###",tangle&;
    '
  CASE "P" !PAINT
    '    ' P FILL
    '    FOR ii&=0 TO 1
    '    aaa&=VAL(FN sift$(a$,i&))*scale
    '    INC i&
    '    IF ii&=0
    '    aw&=aaa&
    '  ELSE
    '    ah&=aaa&
    '  ENDIF
    '  NEXT ii&
    '    DEC i&
    '    'PRINT AT(1,10);USING "fill ### ###",aw&,ah&;
    '
  CASE "X" !EXECUTE SECOND STRING FROM WITHIN A STRING
    ' nil
    nil$="!! IMPLEMENT NOW !!"
    ' PRINT AT(1,11);USING "X.... &",nil$;
    '
    ' *******************
    ' ** CONTROL COMMANDs
    ' *******************
    ' THESE TWO,B+N,CAN PRECEDE ANY OTHER MOVEMENT COMMANDS
    '
  CASE "BU"
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "bu... ###",aaa&;
    MUL aaa&,scale
    SUB ah&,aaa&
    '
  CASE "BD"
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "bd... ###",aaa&;
    MUL aaa&,scale
    ADD ah&,aaa&
    '
  CASE "BR"
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "br... ###",aaa&;
    MUL aaa&,scale
    ADD aw&,aaa&
    '
  CASE "BL"
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "bl... ###",aaa&;
    MUL aaa&,scale
    SUB aw&,aaa&
    '
  CASE "BM" ! BM AXIS X,Y
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "bm1.. ###",aaa&;
    MUL aaa&,scale
    aw&=ax&+aaa&
    INC i&
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,12);USING "bm2.. ###",aaa&;
    MUL aaa&,scale
    ah&=ay&+aaa&
    '
  CASE "N" !MOVE BUT RETURN TO ORIGNAL LOCATION WHEN FINISHED
    ' !nil
    ' "!! IMPLEMENT NOW !!"
    '
    ' ********************
    ' ** MOVEMENT DRAW COMMANDs
    ' ********************
    '
  CASE "U","D","R","L"
    aaa&=VAL(FN sift$(a$,"0","9",i&))
    ' PRINT AT(1,11);USING "UDLR. ###",aaa&;
    MUL aaa&,scale
    SELECT xx$
      '
    CASE "U" !UP
      ax&=aw&
      ay&=ah&
      aw&=ax&
      ah&=ay&-aaa&
      @g.draw(ax&,ay&,aw&,ah&)
      '
    CASE "D" !DOWN
      ax&=aw&
      ay&=ah&
      aw&=ax&
      ah&=ay&+aaa&
      @g.draw(ax&,ay&,aw&,ah&)
      '
    CASE "L" !LEFT
      ax&=aw&
      ay&=ah&
      aw&=ax&-aaa&
      ah&=ay&
      @g.draw(ax&,ay&,aw&,ah&)
      '
    CASE "R" !RIGHT
      ax&=aw&
      ay&=ah&
      aw&=ax&+aaa&
      ah&=ay&
      @g.draw(ax&,ay&,aw&,ah&)
      '
    ENDSELECT
    '
  CASE "E" !DIAGONALLY UP AND RIGHT
    '
  CASE "F" !DIAGONALLY DOWN AND RIGHT
    '
  CASE "G" !DIAGONALLY DOWN AND LEFT
    '
  CASE "H" !DIAGONALLY UP AND LEFT
    '
  CASE "M" !MOVE -/+
    '
  CASE " " !DO NOTHING INCR IN FOR/NEXT
    '
  DEFAULT  !NO DIRECTIVE
    '
  ENDSELECT
  '
  '    ~INP(2)
  '
NEXT i&
'
RETURN
> PROCEDURE g.draw(x&,y&,w&,h&)
DRAW x&,y& TO w&,h&
RETURN
'
'eof
'

obviously requires more streamlining

[dje]

what is the "ueh,dfg,lgh,ref" identifyiers? ...grouped because same response invoked?

There are 4 directions. U,D,L or R will trigger one direction, while E,F,G and H trigger 2, so yes its a grouped response.

but didn't see "p" for paint...fill

I just added the P (paint) option.

Bug fix: I checked against GWBASIC, and it looks like the relative moves are also rotated by angle, so I added a matrix multiply when using stuff like "BM+5,-1". This means, the pen can be relatively moved and paint filled even when a shape is rotated. I'm unsure if the absolute moves are also rotated. I'd have todo more GWBASIC tests.

Code: Select all

 
 DEF PROC Draw(A$)
   LOCAL A,B,X,Xx,Y,Yy,Is_N,Is_B,Is_T,Is_R,C$
   IF Draw_S=0 THEN
     A= VARPTR( MOUSEX )+$25A
     Draw_X= WPEEK(A-$C) SHL 7
     Draw_Y= WPEEK(A-$4) SHL 7
     Draw_Matrix(0,4)
   ENDIF
   FOR A=1 TO LEN(A$) STEP 0
     WHILE MID$(A$,A,1)=" ":A=A+1: WEND
     C$= UPPER$( MID$(A$,A,1)):A=A+1
     Is_N=C$="N": IF Is_N THEN C$= UPPER$( MID$(A$,A,1)):A=A+1
     Is_B=C$="B": IF Is_B THEN C$= UPPER$( MID$(A$,A,1)):A=A+1
     Is_T=C$="T": IF Is_T THEN C$= UPPER$( MID$(A$,A,1)):A=A+1
     IF LEN(C$) THEN
       WHILE MID$(A$,A,1)=" ":A=A+1: WEND
       Is_R= INSTR("_+-", MID$(A$,A,1))>1
       B=A: WHILE INSTR("_+-0123456789", MID$(A$,A,1))>1:A=A+1: WEND
       Xx= VAL( MID$(A$,B,A-B))
       WHILE MID$(A$,A,1)=" ":A=A+1: WEND
       IF MID$(A$,A,1)="," THEN A=A+1
       WHILE MID$(A$,A,1)=" ":A=A+1: WEND
       B=A: WHILE INSTR("_+-0123456789", MID$(A$,A,1))>1:A=A+1: WEND
       Yy= VAL( MID$(A$,B,A-B))
       X=Draw_X:Y=Draw_Y
       IF C$="C" THEN
         LINE COLOR =Xx:Is_B=-1
       ELSE IF C$="S" THEN
         Draw_Matrix(Draw_A,Xx):Is_B=-1
       ELSE IF C$="A" THEN
         IF NOT Is_T THEN Xx=Xx*90
         Draw_Matrix(Xx,Draw_S):Is_B=-1
       ELSE IF C$="P" THEN
         FILL COLOR =Xx
         FILL LOW(X SHR 8), LOW(Y SHR 8),Yy
         Is_B=-1
       ELSE IF C$="M" THEN
         IF Is_R THEN
           Draw_X=Draw_X+Yy*Draw_00+Xx*Draw_01
           Draw_Y=Draw_Y+Yy*Draw_10+Xx*Draw_11
         ELSE
           'Draw_X=-Xx*Draw_00-Yy*Draw_01
           'Draw_Y=-Xx*Draw_10-Yy*Draw_11
           Draw_X=Xx SHL 8
           Draw_Y=Yy SHL 8
         ENDIF
       ELSE
         IF INSTR("UEH",C$) THEN
           Draw_X=Draw_X-Xx*Draw_00-Yy*Draw_01
           Draw_Y=Draw_Y-Xx*Draw_10-Yy*Draw_11
         ENDIF
         IF INSTR("DFG",C$) THEN
           Draw_X=Draw_X+Xx*Draw_00+Yy*Draw_01
           Draw_Y=Draw_Y+Xx*Draw_10+Yy*Draw_11
         ENDIF
         IF INSTR("LGH",C$) THEN
           Draw_X=Draw_X+Yy*Draw_00-Xx*Draw_01
           Draw_Y=Draw_Y+Yy*Draw_10-Xx*Draw_11
         ENDIF
         IF INSTR("REF",C$) THEN
           Draw_X=Draw_X-Yy*Draw_00+Xx*Draw_01
           Draw_Y=Draw_Y-Yy*Draw_10+Xx*Draw_11
         ENDIF
       ENDIF : ENDIF : ENDIF : ENDIF : ENDIF
       IF NOT Is_B THEN
         DRAW LOW(X SHR 8), LOW(Y SHR 8) TO LOW(Draw_X SHR 8), LOW(Draw_Y SHR 8)
       ENDIF
       IF Is_N THEN Draw_X=X:Draw_Y=Y
     ENDIF
   NEXT A
  RETURN
 
  DEF PROC Draw_Matrix(A,B)
   Draw_A=A:Draw_S=B
   Draw_00= SIN(Draw_A* PI /180)*Draw_S*64
   Draw_01= COS(Draw_A* PI /180)*Draw_S*64
   Draw_10=Draw_01
   Draw_11=-Draw_00
 RETURN
 '
 

[dje]

I quickly ported to GFA BASIC. Needs testing for compliance. I doubt I got the rotation and/or relative movements correct. Rotation may also be relative like LOGO. But, the doc's dont explain this. ie: TA45 = Absolute angle, TA+45 = relative angle? BM+40,+20=relative move, or BM+40,20 = relative X, absolute Y?

FYI: My OMIKRON code came from a GWBASIC lib I have which also contains a PLAY command. I convert it to a LIB using MKLIB so I can port GWBASIC games.

grab0001.png

Code: Select all

DEFINT "A-Z"
'
draw("C1")
'
FOR a=1 TO 4
  draw("TA"+STR$(a*40))
  draw("S10C1")
  draw("BM"+STR$(a*60)+",60R3M+1,3D2R1ND2U1R2D4L2U1L1")
  draw("D7R1ND2U2R3D6L3U2L1D3M-1,1L3")
  draw("M-1,-1U3L1D2L3U6R3D2ND2R1U7L1D1L2")
  draw("U4R2D1ND2R1U2")
  draw("M+1,-3")
  draw("BD10D2R3U2M-1,-1L1M-1,1")
  draw("BD3D1R1U1L1BR2R1D1L1U1")
  draw("BD2BL2D1R1U1L1BR2R1D1L1U1")
  draw("BD2BL2D1R1U1L1BR2R1D1L1U1")
  draw("S8")
  draw("BM+0,-15P4,1")
NEXT a
'
FOR a=0 TO 5
  draw("S15TA"+STR$(a*30))
  draw("BM"+STR$(a*60)+",150")
  draw("M+2,-4R8M+1,-1U1M+1,+1M+2,-1")
  draw("M-1,1M+1,3M-1,1M-1,-2M-1,2")
  draw("D3L1U3M-1,1D2L1U2L3D2L1U2M-1,-1")
  draw("D3L1U5M-2,3U1")
  draw("BM+8,0P7,1")
NEXT a
'
REPEAT
UNTIL LEN(INKEY$)
'
END
'
PROCEDURE draw(a$)
  LOCAL a,b,x,xx,y,yy,is_n,is_b,is_t,is_r,c$
  IF draw_s=0
    draw_x=SHL(DPEEK(L~A-&HC),7)
    draw_y=SHL(DPEEK(L~A-&H4),7)
    draw_matrix(0,4)
  ENDIF
  FOR a=1 TO LEN(a$) STEP 0
    WHILE MID$(a$,a,1)=" "
      INC a
    WEND
    c$=UPPER$(MID$(a$,a,1))
    INC a
    is_n=c$="N"
    IF is_n THEN
      c$=UPPER$(MID$(a$,a,1))
      INC a
    ENDIF
    is_b=c$="B"
    IF is_b
      c$=UPPER$(MID$(a$,a,1))
      INC a
    ENDIF
    is_t=c$="T"
    IF is_t
      c$=UPPER$(MID$(a$,a,1))
      INC a
    ENDIF
    IF LEN(c$)
      WHILE MID$(a$,a,1)=" "
        INC a
      WEND
      is_r=INSTR("_+-",MID$(a$,a,1))>1
      b=a
      WHILE INSTR("_+-0123456789",MID$(a$,a,1))>1
        INC a
      WEND
      xx=VAL(MID$(a$,b,a-b))
      WHILE MID$(a$,a,1)=" "
        INC a
      WEND
      IF MID$(a$,a,1)=","
        INC a
      ENDIF
      WHILE MID$(a$,a,1)=" "
        INC a
      WEND
      b=a
      WHILE INSTR("_+-0123456789",MID$(a$,a,1))>1
        INC a
      WEND
      yy=VAL(MID$(a$,b,a-b))
      x=draw_x
      y=draw_y
      IF c$="C"
        COLOR xx
        is_b=TRUE
      ELSE IF c$="S"
        draw_matrix(draw_a,xx)
        is_b=TRUE
      ELSE IF c$="A"
        IF NOT is_t
          MUL xx,90
        ENDIF
        draw_matrix(xx,draw_s)
        is_b=TRUE
      ELSE IF c$="P"
        DEFFILL xx
        FILL WORD(SHR(x,8)),WORD(SHR(y,8)),yy
        is_b=TRUE
      ELSE IF c$="M"
        IF is_r
          ADD draw_x,MUL(yy,draw_00)+MUL(xx,draw_01)
          ADD draw_y,MUL(yy,draw_10)+MUL(xx,draw_11)
        ELSE
          draw_x=SHL(xx,8)
          draw_y=SHL(yy,8)
        ENDIF
      ELSE
        IF INSTR("UEH",c$)
          SUB draw_x,MUL(xx,draw_00)-MUL(yy,draw_01)
          SUB draw_y,MUL(xx,draw_10)-MUL(yy,draw_11)
        ELSE IF INSTR("DFG",c$)
          ADD draw_x,MUL(xx,draw_00)+MUL(yy,draw_01)
          ADD draw_y,MUL(xx,draw_10)+MUL(yy,draw_11)
        ENDIF
        IF INSTR("LGH",c$)
          ADD draw_x,MUL(yy,draw_00)-MUL(xx,draw_01)
          ADD draw_y,MUL(yy,draw_10)-MUL(xx,draw_11)
        ELSE IF INSTR("REF",c$)
          SUB draw_x,MUL(yy,draw_00)-MUL(xx,draw_01)
          SUB draw_y,MUL(yy,draw_10)-MUL(xx,draw_11)
        ENDIF
      ENDIF
      IF NOT is_b
        LINE WORD(SHR(x,8)),WORD(SHR(y,8)),WORD(SHR(draw_x,8)),WORD(SHR(draw_y,8))
      ENDIF
      IF is_n
        draw_x=x
        draw_y=y
      ENDIF
    ENDIF
  NEXT a
RETURN
'
PROCEDURE draw_matrix(a,b)
  draw_a=a
  draw_s=b
  draw_00=SIN(draw_a*PI/180)*draw_s*64
  draw_01=COS(draw_a*PI/180)*draw_s*64
  draw_10=draw_01
  draw_11=-draw_00
RETURN

[charles]

youve really done well with this...
as probally can tell ive found some old gw basica ms basic code
im porting...

so whats next? implment the 'x' directive i to your code?

most of my basiccode ive found to try is in softside or mrdobbs

https://archive.org/details/softside-magazine-38

[charles]

dje? is this an error ?
I did a comparison ....
my code uses some repetition but isolates a common shape 4 times

when ran under your algo the rendering ,,,,after a "BR" I assume,,seems to double the width of my end

please see pictures

[charles]

but it could be my algo?
relative /absolute?

[dje]

Looks like a scaling issue. Try changing the scale to a multiple of 4. ie: 4,8,12,16
I just tested GWBASIC, and it has a similar problem, but for the Y axis.

Increasing the fixed point accuracy didn't fix the issue, nor did rounding before truncating fixed point numbers.

I'm unsure how to fix your situation without causing issues with scaling/rotating vector shapes. The best solution for now is to use a different scale.

Edit: To document the issue....

The default scale is 4 = 1x, which means, 8 = 2x, 12 = 3x and 16 =4x. You are using scale 10, which is 2.5x. Since pixels cant be 2.5 pixels in width, some will be 2 pixels while others will be 3. You can "mask" the problem by limiting the scale, but then that limits the options for vector shapes. The solution may be to limit the scale options, and if you want a custom scale, then call draw_matrix.

[charles]

I use integer divide
will ignore decimal values
gfa
div and \ =whole# only
/ =whole# + decimals

[dje]

I use integer divide .will ignore decimal values
gfa div and \ =whole# only
/ =whole# + decimals

It isn't a rounding issue. But, you are more than welcome to experiment. You can see from your screenshots that the staff image rendered by my code is larger than the staff image rendered by your code. But the size increase is not double, which means some pixels must be larger than others. Even if you use floating point math, you are still going to get uneven rounding. It is often referred to as "aliasing".

[dje]

Ok. I did a little more thinking. Here is your code rendering S8, S10 and S16

grab0001.png

You can see that your code renders S8 and S10 at the same size. Even though your scale variable is float, your multiplies round down to int. Even if you use floats for X and Y, the rounding to int for the LINE command will cause the aliasing.

I don't see a workaround other than to limit scales to multiples of 4.

[charles]

yes did notice the scalar differance


setting my life to a theme.....
motto will be...

time for a rewrite...
thats mainly what i do now rewrite my older programs


tmo is a nice chance to try further.

unless u can verify from some dissasembly that thats how gw basica routine executes?

[dje]

unless u can verify from some dissasembly that thats how gw basica routine executes?

It looks like GWBASIC limits the X axis scale to multiples of 4 as you can see in this screen shot of OMIKRON vs GWBASIC. Note, the X size doesn't increase while the Y size does.

2023-08-22-145437_1920x1080_scrot.png

The quick fix is to change Draw_Matrix to this: (Note: AND -4 which limits Draw_S to multiples of 4 for the X axis)

Code: Select all

DEF PROC Draw_Matrix(A,B)
  Draw_A=A:Draw_S=B
  Draw_00= SIN(Draw_A* PI /180)*(Draw_S AND -4)*64
  Draw_01= COS(Draw_A* PI /180)*Draw_S*64
  Draw_10=Draw_01
  Draw_11=-Draw_00
RETURN

A better solution would be to pass X and Y scales to Draw_Matrix and limit the X scale in the Draw procedure. That way you can still call Draw_Matrix directly for custom scaling. ie: Adjust for pixel sizes for non square pixels or correct scaling of vector shapes.

The testing code was this for both OMIKRON and GWBASIC:

Code: Select all

1 FOR A=4 TO 10
2   PROC Draw "BM0,"+ STR$((A-4)*16)+"S"+ STR$(A)
3   PROC Draw "D8R2U8R2D8"
4 NEXT A

[dje]

O, bugger. Still not fixed. I give up. Just use scale 8

[charles]

you know more than me but
seems as simple as
scale=int (scale div 4)

we can insert values 1 to 255


so would scale also mess with line thicknes?

i noticed atari 800 has a microsoft basic
and wondering if pascal pure pascal has a routine to crack

i might just have to get a copy of basica or basic or gw to test myself

[dje]

you know more than me but seems as simple as scale=int (scale div 4) we can insert values 1 to 255

You can already achieve this by only using multiples of 4. By dividing by 4 and then truncating, you then loose pixel sub-scaling.

The code is correct, in that a given vector shape is correctly scaled. The way MS gets around this perceived issue was to restrict the X axis scale to multiples of 4, and leave the Y axis scaler untouched.

But, IMHO, this is a faulty solution. Imaging you have a space ship, and you what it to rotate and resize it into BITBLT frames. The GWBASIC solution would mean the ship would grow taller, and then "kick" at each X scale boundary. ie: 1X, 2X, 3X, 4X, 5X etc. So, you couldn't create a smooth zoom.

The GWBASIC method can be implemented, but I would need 2 matrices. One with the X axis limited to multiples of 4, and the other for the Y axis. Currently I used the same matrix and use matrix transposing & inverting to rotate relative moves in 4 directions.

I can fix it, but its not high on my todo list atm. I dont need/want the GWBASIC method since it doesn't suit what I need from a vector drawing function.

Plus, at the end of the day, scales of multiples of 4 should work fine. Its just your S10 thats causing the issue.

[charles]

Well my perception might be weary but in the manual it says any of the distances applied are just multiplied by your scale so I assume that means X or Y and both

[charles]

Oh yeah this is just novel stuff it's not the cash crop of code I was really just searching for a routine that would get my picture up and going that mainly conforms to what the old standards achieved thanks for your help dje

[charles]

Alarming discovery GFA already incorporates a draw function and it's almost identical to Microsoft's GW basica

[charles]

REWRITE !!!!
RE-READ!!!
LOL

GFA VERSION USING ITS INTERNAL DRAW COMMAND

Code: Select all

' sof
'
LIST "a:\newdraw1.lst"
'
' gw           =  gfa
' -------------------------------
' scale     s  =  SX x/SY y
' turn2     a  =  TT x
' move abs  bm =  MA x,y  absolute!!!no  need coords+scale
' draw abs  ?  =  DA x,y  ????
' move rel  +/-=  MR x,y  relative!!!no  ???work upon
' DRAW REL  ????? NO TIME ,,WORK UPON
' color     c  =  CO x
' backwrd   D  =  BK x
' forward   u  =  FD x
' ??????????? WHAT IS FDP COORDINATES?????????
' -------------------------------
scale&=10
scale&=scale& DIV 4
' "S10 A000 BM0,0 C1 "
staff$="sx"+STR$(scale&)+"sy"+STR$(scale&)+"tt0 mA0,0 co1"
' "D8 R1 U8 L1 R1 BR40 "
staff$=staff$+"pd bk8 rt90 fd1 tt0 fd8 lt90 fd1 rt180 fd1 "
' "D8 R1 U8 L1 "
staff$=staff$+"pu fd40 pd tt0 "
staff$=staff$+"bk8 rt90 fd1 tt0 fd8 lt90 fd1"
' "L40 D2 R40 D2 L40 D2 R40 D2 L40 "
staff$=staff$+"fd40 tt0 bk2 rt90 fd40 tt0 bk2 lt90 fd40 tt0 bk2 rt90 fd40 tt0 bk2 lt90 fd40"
' "L1 D8 "
staff$=staff$+"fd1 tt0 bk8"
' "D8 R1 U8 L1 R1 BR40 "
staff$=staff$+"pd bk8 rt90 fd1 tt0 fd8 lt90 fd1 rt180 fd1 "
' "D8 R1 U8 L1 "
staff$=staff$+"pu fd40 pd tt0 "
staff$=staff$+"bk8 rt90 fd1 tt0 fd8 lt90 fd1"
' "L40 D2 R40 D2 L40 D2 R40 D2 L40 "
staff$=staff$+"fd40 tt0 bk2 rt90 fd40 tt0 bk2 lt90 fd40 tt0 bk2 rt90 fd40 tt0 bk2 lt90 fd40"
'
CLS
DRAW staff$
CLR staff$
GET 0,0,42*scale&,24*scale&,staff$
CLS
PUT 5*scale&,5*scale&,staff$
END
' --------------OLD---------------
' staff$="S10 A000 BM0,0 C2 "
' staff$=staff$+"D8 R1 U8 L1 R1 BR40 "
' staff$=staff$+"D8 R1 U8 L1 "
' staff$=staff$+"L40 D2 R40 D2 L40 D2 R40 D2 L40 "
' staff$=staff$+"L1 D16 R1 U8 L1 R1 BR40 "
' staff$=staff$+"D8 R1 U8 L1 "
' staff$=staff$+"L40 D2 R40 D2 L40 D2 R40 D2 L40 "
'
' eof