' Demoprogramm fuer eine Befehlseingabe durch Freihandsymbole (hier
' mit der Maus). Grundprinzip wie bei Bravo3®
' © 1992 by Andreas Meile
' hier am Beispiel eines sehr primitiven Malprogrammes

DIM px%(4095),py%(4095)
c%=2:cU%=1:uF%=1:Sketch%=0
x%=WINDOW(2)\2:y%=4+WINDOW(3)\2
Pox%=x%:Poy%=y%
DIM Kreuz%(16),Schlp%(16)
LINE (7,0)-(7,6),3
LINE (0,3)-(14,3),3
GET (0,0)-(14,6),Kreuz%
LINE (0,0)-(14,6),3,bf
LINE (4,0)-(10,6),0,bf
LINE (0,2)-(14,4),0,bf
GET (0,0)-(14,6),Schlp%
WeitererBefehl:
LOCATE 1,1
IF Sketch%=0 THEN
  COLOR 1,0
  PRINT "Strichfarbe ";CHR$(32+30*uF%);
  COLOR ,cU%:PRINT "  ";
  COLOR ,0
  PRINT CHR$(32+28*uF%);" Füllfarbe ";CHR$(62-30*uF%);
  COLOR ,c%:PRINT "  ";
  COLOR ,0
  PRINT CHR$(60-28*uF%);" Bitte geben Sie ein einteiliges Symbol ein: W";SPACE$(3);
ELSE
  COLOR 3,0
  PRINT " Bitte zeichnen Sie eine Freihandlinie:";SPACE$(41);
END IF
PUT (x%-7,y%-3),Kreuz%
PUT (Pox%-7,Poy%-3),Schlp%
LOCATE 1,77:PRINT "B";
WHILE MOUSE(0)>-1
WEND
a%=1
px%(0)=MOUSE(1)
py%(0)=MOUSE(2)
PSET (px%(0),py%(0)),POINT(px%(0),py%(0))XOR 3
LOCATE 1,77:PRINT "U";
WHILE MOUSE(0)<0
  IF a%<4095 THEN
    px%(a%)=MOUSE(1)
    py%(a%)=MOUSE(2)
    IF px%(a%)>=WINDOW(2) THEN px%(a%)=WINDOW(2)-1
    IF py%(a%)>=WINDOW(3) THEN py%(a%)=WINDOW(3)-1
    IF py%(a%)<8 THEN py%(a%)=8
    IF ABS(px%(a%)-px%(a%-1))+2*ABS(py%(a%)-py%(a%-1))>3 THEN
      PSET (px%(a%),py%(a%)),POINT(px%(a%),py%(a%))XOR 3
      a%=a%+1
    END IF
  ELSE
    BEEP
  END IF
WEND
px%(a%)=MOUSE(1)
py%(a%)=MOUSE(2)
IF px%(a%)>=WINDOW(2) THEN px%(a%)=WINDOW(2)-1
IF py%(a%)>=WINDOW(3) THEN py%(a%)=WINDOW(3)-1
IF py%(a%)<8 THEN py%(a%)=8
PSET (px%(a%),py%(a%)),POINT(px%(a%),py%(a%))XOR 3
LOCATE 1,77:PRINT "F";

' Auswerten des Symboles wie bei Bravo3: Rechteck um Symbol legen,
' dieses dreiteilen, Startzone und Zahl der Schnittpunkte an den
' Drittelungslinien ermitteln
xi%=px%(0):xa%=px%(0)
yi%=py%(0):ya%=py%(0)
FOR i%=0 TO a%
  PSET (px%(i%),py%(i%)),POINT(px%(i%),py%(i%))XOR 3
  IF px%(i%)<xi% THEN xi%=px%(i%)
  IF px%(i%)>xa% THEN xa%=px%(i%)
  IF py%(i%)<yi% THEN yi%=py%(i%)
  IF py%(i%)>ya% THEN ya%=py%(i%)
NEXT i%
dx%=xa%-xi%+1
dy%=ya%-yi%+1
sx%=(px%(0)-xi%)*3\dx%
sy%=(py%(0)-yi%)*3\dy%
asx%=sx%:asy%=sy%
sco%=0:scu%=0:scl%=0:scr%=0
FOR i%=1 TO a%
  sx1%=(px%(i%)-xi%)*3\dx%
  sy1%=(py%(i%)-yi%)*3\dy%
  IF sx1%+asx%=1 THEN scl%=scl%+1
  IF sx1%+asx%=3 THEN scr%=scr%+1
  IF sy1%+asy%=1 THEN sco%=sco%+1
  IF sy1%+asy%=3 THEN scu%=scu%+1
  asx%=sx1%:asy%=sy1%
NEXT i%
PUT (x%-7,y%-3),Kreuz%
PUT (Pox%-7,Poy%-3),Schlp%
LOCATE 1,1:COLOR ,cU%
PRINT SPACE$(80);
IF Sketch%=1 THEN
  x%=px%(0):y%=py%(0)
  PSET (px%(0),py%(0)),cU%
  FOR i%=1 TO a%
    LINE -(px%(i%),py%(i%)),cU%
  NEXT i%
  Pox%=px%(a%):Poy%=py%(a%)
  Sketch%=0
ELSEIF sx%=1 AND sy%=0 AND scl%=2 AND scr%=2 AND sco%=2 AND scu%=2 THEN
  IF uF%=1 THEN
    cU%=0
  ELSE
    c%=0
  END IF
ELSEIF sx%=0 AND sy%=1 AND scl%=1 AND scr%=1 AND sco%=2 AND scu%=1 THEN
  IF uF%=1 THEN
    cU%=1
  ELSE
    c%=1
  END IF
ELSEIF sx%=0 AND sy%=0 AND scl%=3 AND scr%=3 AND sco%=1 AND scu%=1 THEN
  IF uF%=1 THEN
    cU%=2
  ELSE
    c%=2
  END IF
ELSEIF sx%=0 AND sy%=0 AND scl%=4 AND scr%=4 AND sco%=1 AND scu%=1 THEN
  IF uF%=1 THEN
    cU%=3
  ELSE
    c%=3
  END IF
ELSEIF sx%=0 AND sy%=2 AND scl%=2 AND scr%=2 AND sco%=2 AND scu%=1 THEN
  x%=px%(0)
  y%=py%(0)
  Pox%=x%
  Poy%=y%
ELSEIF sx%=2 AND sy%=2 AND scl%=2 AND scr%=2 AND sco%=2 AND scu%=1 THEN
  x%=Pox%:y%=Poy%
ELSEIF sx%=0 AND sy%=0 AND scl%=1 AND scr%=2 AND sco%=1 AND scu%=1 THEN
  uF%=1-uF%
ELSEIF sx%=2 AND sy%=2 AND scl%=1 AND scr%=1 AND sco%=1 AND scu%=1 THEN
  LINE (x%,y%)-(px%(0),py%(0)),cU%
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=0 AND sy%=0 AND scl%=1 AND scr%=1 AND sco%=1 AND scu%=1 THEN
  LINE (Pox%,Poy%)-(px%(0),py%(0)),cU%
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=0 AND scl%=3 AND scr%=3 AND sco%=1 AND scu%=1 THEN
  LINE (Pox%,Poy%)-(x%,y%),cU%
  Pox%=x%:Poy%=y%
ELSEIF sx%=2 AND sy%=0 AND scl%=3 AND scr%=3 AND sco%=2 AND scu%=2 THEN
  CIRCLE (x%,y%),SQR(CSNG(x%-px%(0))^2!+CSNG(2*(y%-py%(0)))^2!),cU%,,,.5
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=0 AND sy%=0 AND scl%=3 AND scr%=3 AND sco%=2 AND scu%=2 THEN
  CIRCLE (x%,y%),SQR(CSNG(x%-px%(0))^2!+CSNG(2*(y%-py%(0)))^2!),cU%,,,.5
  PSET (x%,y%),cU% XOR 3
  PAINT (x%,y%),c%,cU%
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=0 AND scl%=1 AND scr%=1 AND sco%=1 AND scu%=1 THEN
  LINE (px%(0),py%(0))-(px%(a%),py%(a%)),cU%,b
  x%=px%(0):y%=py%(0)
  Pox%=px%(a%):Poy%=py%(a%)
ELSEIF sx%=0 AND sy%=2 AND scl%=1 AND scr%=1 AND sco%=1 AND scu%=1 THEN
  LINE (px%(0),py%(0))-(px%(a%),py%(a%)),c%,bf
  LINE (px%(0),py%(0))-(px%(a%),py%(a%)),cU%,b
  x%=px%(0):y%=py%(0)
  Pox%=px%(a%):Poy%=py%(a%)
ELSEIF sx%=0 AND sy%=2 AND scl%=2 AND scr%=2 AND sco%=1 AND scu%=1 THEN
  LINE (x%,y%)-(px%(0),py%(0)),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=0 AND sy%=0 AND scl%=2 AND scr%=2 AND sco%=1 AND scu%=1 THEN
  LINE (x%,y%)-(px%(0),py%(0)),c%,bf
  LINE (x%,y%)-(px%(0),py%(0)),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=0 AND scl%=2 AND scr%=2 AND sco%=1 AND scu%=1 THEN
  LINE (2*x%-px%(0),2*y%-py%(0))-(px%(0),py%(0)),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=2 AND scl%=2 AND scr%=2 AND sco%=1 AND scu%=1 THEN
  LINE (2*x%-px%(0),2*y%-py%(0))-(px%(0),py%(0)),c%,bf
  LINE (2*x%-px%(0),2*y%-py%(0))-(px%(0),py%(0)),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=2 AND scl%=1 AND scr%=1 AND sco%=2 AND scu%=2 THEN
  dx%=ABS(px%(0)-x%)
  dy%=2*ABS(py%(0)-y%)
  IF dx%>dy% THEN
    d%=dx%
  ELSE
    d%=dy%
  END IF
  LINE (x%-d%,y%-d%\2)-(x%+d%,y%+d%\2),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=0 AND sy%=2 AND scl%=1 AND scr%=1 AND sco%=2 AND scu%=2 THEN
  dx%=ABS(px%(0)-x%)
  dy%=2*ABS(py%(0)-y%)
  IF dx%>dy% THEN
    d%=dx%
  ELSE
    d%=dy%
  END IF
  LINE (x%-d%,y%-d%\2)-(x%+d%,y%+d%\2),c%,bf
  LINE (x%-d%,y%-d%\2)-(x%+d%,y%+d%\2),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=0 AND sy%=0 AND scl%=1 AND scr%=1 AND sco%=2 AND scu%=2 THEN
  dx%=ABS(px%(0)-x%)
  dy%=2*ABS(py%(0)-y%)
  IF dx%>dy% THEN
    d%=dx%
  ELSE
    d%=dy%
  END IF
  LINE (x%,y%)-(x%+d%*SGN(px%(0)-x%),y%+d%*SGN(py%(0)-y%)\2),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=0 AND scl%=1 AND scr%=1 AND sco%=2 AND scu%=2 THEN
  dx%=ABS(px%(0)-x%)
  dy%=2*ABS(py%(0)-y%)
  IF dx%>dy% THEN
    d%=dx%
  ELSE
    d%=dy%
  END IF
  LINE (x%,y%)-(x%+d%*SGN(px%(0)-x%),y%+d%*SGN(py%(0)-y%)\2),c%,bf
  LINE (x%,y%)-(x%+d%*SGN(px%(0)-x%),y%+d%*SGN(py%(0)-y%)\2),cU%,b
  Pox%=px%(0):Poy%=py%(0)
ELSEIF sx%=2 AND sy%=0 AND scl%=4 AND scr%=4 AND sco%=1 AND scu%=1 THEN
  rx%=ABS(px%(0)-x%)
  ry%=ABS(py%(0)-y%)
  IF rx%<>0 AND ry%<>0 THEN
    a!=CSNG(ry%)/CSNG(rx%)
    IF a!>1! THEN
      r%=ry%
    ELSE
      r%=rx%
    END IF
    CIRCLE (x%,y%),r%,cU%,,,a!
    Pox%=px%(0):Poy%=py%(0)
  ELSE
    BEEP
  END IF
ELSEIF sx%=2 AND sy%=2 AND scl%=4 AND scr%=4 AND sco%=1 AND scu%=1 THEN
  rx%=ABS(px%(0)-x%)
  ry%=ABS(py%(0)-y%)
  IF rx%<>0 AND ry%<>0 THEN
    a!=CSNG(ry%)/CSNG(rx%)
    IF a!>1! THEN
      r%=ry%
    ELSE
      r%=rx%
    END IF
    CIRCLE (x%,y%),r%,cU%,,,a!
    PSET (x%,y%),cU% XOR 3
    PAINT (x%,y%),c%,cU%
    Pox%=px%(0):Poy%=py%(0)
  ELSE
    BEEP
  END IF
ELSEIF sx%=2 AND sy%=0 AND scl%=2 AND scr%=2 AND sco%=1 AND scu%=2 THEN
  PAINT (px%(0),py%(0)),c%,cU%
ELSEIF sx%=2 AND sy%=0 AND scl%=2 AND scr%=2 AND sco%=3 AND scu%=3 THEN
  Sketch%=1
ELSEIF sx%=0 AND sy%=2 AND scl%=4 AND scr%=4 AND sco%=2 AND scu%=2 THEN
  LOCATE 1,1:COLOR 1,0
  PRINT "Ende!";SPACE$(75);
  END
ELSE
  BEEP
END IF
GOTO WeitererBefehl