home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol048 / digidraw.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-11  |  7.9 KB  |  100 lines
  1. 1  CLEAR,,1024 : ON ERROR GOTO 30000 : SCREEN 2 : KEY OFF : CLS
  2. 2  DEF SEG=&HB800 : BLOAD "LOGO.BIN",0
  3. 3  LOCATE 25,30 : PRINT " Hit ANY key to start"; : FOR I=1 TO 200 : NEXT I
  4. 4  S$=INKEY$ : IF S$="" THEN LOCATE 25,30 : PRINT"                     ";:GOTO 3
  5. 5  CLS : BLOAD "INFO.BIN",0
  6. 6  LOCATE 25,30 : PRINT "Hit ANY key to procede"; : FOR I=1 TO 200 : NEXT I
  7. 7  S$=INKEY$ : IF S$="" THEN LOCATE 25,30 : PRINT "                        "; :   GOTO 6
  8. 9  DEFINT A-Y : INC=1 : PENCIL=1 : C=0 : SCREEN 2 : CLS : FUNC=3 : PASS=0
  9. 10  R=4 : R$(1)="PSET" : R$(2)="PRESET" : R$(3)="XOR" : R$(4)="OR"                   : R$(5)="AND"
  10. 11  DIM IMAGE(10,10) : S=3 : ZPI=3.14159
  11. 12  REM DIGIDRAW IS THE PROPERTY OF AUTUMN SOFTWARE. YOU ARE ENCOURAGED TO COPY
  12. 13  REM AND SHARE DIGIDRAW WITH OTHER PC USERS. MAKE SURE THE FOLLOWING FOUR
  13. 14  REM FILES ARE COPIED : DIGIDRAW.BAS, LOGO.BIN, INFO.BIN, AND DIGIDRAW.DOC
  14. 15  REM DIGIDRAW.DOC CONTAINS PROGRAM DIRECTIONS.
  15. 16  REM IF YOU FIND DIGIDRAW USEFUL, A CONTRIBUTION ($15. SUGGESTED) WILL BE
  16. 17  REM GREATLY APPRECIATED.  THANK YOU!!
  17. 18  REM    AUTUMN SOFTWARE   BOX 253C   GREENPOINT RD.  LAVALE, MD.  21502
  18. 19  REM ******************************************************************
  19. 20  ON KEY(1) GOSUB 1000 : ON KEY(2) GOSUB 2000 : ON KEY(3) GOSUB 3000
  20. 30  ON KEY(4) GOSUB 4000 : ON KEY(5) GOSUB 5000 : ON KEY(6) GOSUB 6000
  21. 40  ON KEY(7) GOSUB 7000 : ON KEY(8) GOSUB 8000 : ON KEY(9) GOSUB 9000
  22. 50  ON KEY(10) GOSUB 10000 : ON KEY(11) GOSUB 900 : ON KEY(12) GOSUB 910
  23. 60  ON KEY(13) GOSUB 920 : ON KEY(14) GOSUB 930
  24. 70  FOR I=1 TO 14 : KEY(I) ON : NEXT I
  25. 75  GOSUB 1000 : GOSUB 2000 : GOSUB 3000  : GOSUB 9000 : GOSUB 10000
  26. 80  X=320 : Y=100 : NX=X : NY=Y : OP=0
  27. 90  PSET (X,Y) : PRESET (X,Y)
  28. 100  K$=INKEY$ : IF K$="" GOTO 90
  29. 101  IF ASC(K$) = 27 THEN PASS=0
  30. 102  IF LEN(K$)=2 THEN K$=RIGHT$(K$,1) : GOSUB 950
  31. 110  GOTO 90
  32. 900  KEY(11) OFF
  33. 901  NY=Y-INC : NX=X : GOSUB 20000 : GOSUB 990
  34. 902  KEY(11) ON : RETURN
  35. 910  KEY(12) OFF
  36. 911  NX=X-INC : NY=Y : GOSUB 20000 : GOSUB 990
  37. 912  KEY(12) ON : RETURN
  38. 920  KEY(13) OFF
  39. 921  NX=X+INC : NY=Y : GOSUB 20000 : GOSUB 990
  40. 922  KEY(13) ON : RETURN
  41. 930  KEY(14) OFF
  42. 931  NY=Y+INC : NX=X : GOSUB 20000 : GOSUB 990
  43. 932  KEY(14) ON : RETURN
  44. 950  IF K$="G" THEN NX=X-INCX : NY=Y-INC : GOSUB 21000 : GOSUB 990 :RETURN
  45. 960  IF K$="I" THEN NX=X+INCX : NY=Y-INC : GOSUB 21000 : GOSUB 990 : RETURN
  46. 970  IF K$="O" THEN NX=X-INCX : NY=Y+INC : GOSUB 21000 : GOSUB 990 : RETURN
  47. 980  IF K$="Q" THEN NX=X+INCX : NY=Y+INC : GOSUB 21000 : GOSUB 990 :RETURN
  48. 981  IF K$="R" THEN GOSUB 11000 : RETURN
  49. 982  IF ASC(K$)= 25 THEN KEY OFF : LOCATE 25,3 : PRINT "  Present Pencil Position = " X;Y; : FOR I=1 TO 2500 : NEXT I : KEY ON
  50. 983  IF ASC(K$)= 18 THEN CLS :OP=0 : RETURN
  51. 984  IF ASC(K$)= 19 THEN GOTO 985 ELSE RETURN
  52. 985  KEY OFF : LOCATE 25,1 : PRINT "Present RECALL= "; R$(R); "   PSET=1  PRESET=2  XOR=3  OR=4  AND=5 Enter new number ";
  53. 986  K$=INKEY$ : IF K$="" THEN GOTO 986
  54. 987  IF ASC(K$) >48 AND ASC(K$) <54 THEN LOCATE 25,78 : PRINT K$; ELSE GOTO 986
  55. 988  R=ASC(K$)-48 :KEY ON : RETURN
  56. 990  IF PENCIL=0 THEN GOTO 992
  57. 991  LINE (X,Y)-(NX,NY),C : OP=C : X=NX : Y=NY :  RETURN
  58. 992  PSET (X,Y),OP : OP=POINT(NX,NY) : X=NX : Y=NY : PSET(X,Y),C : RETURN
  59. 1000  KEY(1) OFF
  60. 1010  IF PENCIL=0 THEN PENCIL=1 ELSE PENCIL=0
  61. 1020  IF PENCIL=0 THEN KEY 1,"Pen up"
  62. 1030  IF PENCIL=1 THEN KEY 1,"Pen dn"
  63. 1040  KEY(1) ON : RETURN
  64. 2000  KEY(2) OFF
  65. 2010  IF C=0 THEN C=1 ELSE C=0
  66. 2020  IF C=0 THEN KEY 2,"Erase"
  67. 2030  IF C=1 THEN KEY 2,"Point"
  68. 2040  KEY(2) ON : RETURN
  69. 3000  KEY(3) OFF
  70. 3010  INC=INC+1 : INCX=INC*3 : IF INC=23 THEN  BEEP
  71. 3015  IF INC=26 THEN INC=1 : INCX=3
  72. 3020  KEY 3,"pm="+STR$(INC)
  73. 3030  KEY(3) ON : RETURN
  74. 4000  KEY(4) OFF
  75. 4010  PASS=PASS+1
  76. 4020  IF PASS=1 THEN FX=X : FY=Y : GOTO 4900
  77. 4030  IF PASS=2 THEN SX=X : SY=Y : PASS=0 : ON FUNC GOTO 4040,4050
  78. 4040  LINE (FX,FY)-(SX,SY),C : OP=C : GOTO 4900
  79. 4050  LINE (FX,FY)-(SX,SY),C,B : OP=C
  80. 4900  KEY(4) ON : RETURN
  81. 5000  KEY(5) OFF  : ON FUNC GOTO 5010,5200
  82. 5010  PASS=PASS+1 : IF PASS=1 THEN FX=X : FY=Y : OP=1 : GOTO 5900
  83. 5020  IF PASS=2 THEN SX=X : SY=Y : OP=1 : GOTO 5900
  84. 5030  IF PASS=3 THEN PASS=0
  85. 5100  LINE(X,Y)-(SX,SY),C : OP=C
  86. 5110  LINE(SX,SY)-(FX,FY),C
  87. 5120  LINE(FX,FY)-(X,Y),C : GOTO 5900
  88. 5200  PASS=PASS+1
  89. 5210  IF PASS=1 THEN FX=X : FY=Y : GOTO 5900
  90. 5220  IF PASS=2 THEN GOTO 5300
  91. 5230  IF PASS=3 THEN PASS=0 : GOTO 5900
  92. 5300  ZBX=ABS((FX-X)^2) : ZBY=ABS(((FY-Y)*2.4)^2) : RA=INT(SQR(ZBX+ZBY))
  93. 5310  DX=X-FX : DY=2.4*(Y-FY) : IF DX=0 OR DY=0 THEN GOTO 5341 ELSE ZANG=ATN(ABS(DY/DX))
  94. 5311  IF DX >= 0 AND DY <= 0 THEN ZQUAD = 0 : GOTO 5350
  95. 5320  IF DX <= 0 AND DY <= 0 THEN ZQUAD = -1*ZPI : GOTO 5350
  96. 5330  IF DX <= 0 AND DY >= 0 THEN ZQUAD = ZPI : GOTO 5350
  97. 5340  IF DX >= 0 AND DY >= 0 THEN ZQUAD = -2*ZPI : GOTO 5350
  98. 5341  IF DX= 0 AND DY> 0 THEN ZANG=3*ZPI/2
  99. 5342  IF DY= 0 AND DX> 0 THEN ZANG=0
  100.