home *** CD-ROM | disk | FTP | other *** search
/ Generous Efforts of Many / gemcd.zip / GEM.CD.A.po / FEATURES:BEAGLE / SHAPE.MECH1.SHK / SHAPE.MECHANIC / SHAPE.CAPTURE.bas < prev    next >
BASIC Source File  |  2000-01-01  |  3KB  |  34 lines
  1. 0  REM <CTRL-M><CTRL-M>===============<CTRL-M> SHAPE CAPTURE<CTRL-M> (C) 1985<CTRL-M> MARK SIMONSEN<CTRL-M> BEAGLE BROS<CTRL-M>===============<CTRL-M>
  2. 1  IF  PEEK(103) + PEEK(104) *256 < >2049  THEN  POKE 2048,0: POKE 103,1: POKE 104,8: PRINT  CHR$(4)"RUN SHAPE.CAPTURE"
  3. 2  SPEED= 255: NOTRACE : LOMEM: 32768: PRINT  CHR$(21): TEXT : NORMAL :D$ =  CHR$(4)
  4. 3  PRINT D$"BLOAD SHAPE.CAPTUR.ML"
  5. 4  CALL 4096 +13: POKE 24576,0: POKE 4096 +16,4: POKE 4096 +17,96
  6. 5  DIM E$(13):E$(4) = "WRITE-PROTECT":E$(6) = "PATH NOT FOUND":E$(8) = "I/O":E$(9) = "DISK FULL":E$(10) = "FILE LOCKED":E$(11) = "SYNTAX":E$(13) = "FILE TYPE MISMATCH"
  7. 6  ONERR  GOTO 31
  8. 7  POKE 230,32: POKE  -16304,0: POKE  -16301,0: POKE  -16300,0: POKE  -16297,0
  9. 8  HOME : VTAB 22: GOSUB 30
  10. 9  PRINT "OUTLINE  LOAD PIC    CATALOG        QUIT         SAVE SHAPE  PREFIX";
  11. 10  INVERSE : VTAB 23: HTAB 1: PRINT "O";: HTAB 10: PRINT "L";: HTAB 22: PRINT "C";: HTAB 37: PRINT "Q": HTAB 10: PRINT "S";: HTAB 22: PRINT "P";: NORMAL : HTAB 1: PRINT  PEEK(24576);
  12. 11  VTAB 21: HTAB 1: PRINT "SELECT:";: GET A$: PRINT A$:A$ =  CHR$( ASC(A$) -32 *( ASC(A$) >95))
  13. 12  ON A$ = "O" GOTO 14: ON A$ = "L" GOTO 20: ON A$ = "S" GOTO 22: ON A$ = "C" GOTO 25: ON A$ = "P" GOTO 26: IF A$ < >"Q"  THEN 11
  14. 13  HOME : VTAB 21: PRINT "QUIT NOW? (Y/N): ";: GET A$: ON A$ < >"Y"  AND A$ < >"y" GOTO 8: HOME : VTAB 23: DEL 3,3: END 
  15. 14  ON  PEEK(24576) = 255 GOTO 8: POKE  -16302,0: POKE 5120 +9,179: CALL 5120:K =  PEEK( -16384): POKE  -16368,0:A$ =  CHR$(K -128)
  16. 15 X1 =  PEEK(5120 +3) + PEEK(5120 +4) *256:Y1 =  PEEK(5120 +5):X2 =  PEEK(5120 +6) + PEEK(5120 +7) *256:Y2 =  PEEK(5120 +8)
  17. 16  IF A$ < > CHR$(13)  THEN  POKE  -16301,0: GOTO 8
  18. 17  POKE 4096 +3,Y1: POKE 4096 +4,Y2: POKE 4096 +5,X1 - INT(X1/256) *256: POKE 4096 +6, INT(X1/256): POKE 4096 +7,X2 - INT(X2/256) *256: POKE 4096 +8, INT(X2/256): CALL 4096: CALL 4096 +9: POKE  -16301,0
  19. 18  IF   NOT  PEEK(4096 +12)  THEN SFLAG = 1: GOTO 8
  20. 19  HOME : VTAB 21: PRINT  CHR$(7)"TOO LARGE...TRY A SMALLER WINDOW": GOSUB 29: GOTO 14
  21. 20  HOME : VTAB 23: PRINT "<RETURN> TO CANCEL": VTAB 21: INPUT "LOAD PICTURE NAMED:";N$: IF   NOT  LEN(N$)  THEN 8
  22. 21  CALL  -958: PRINT : PRINT D$"BLOAD "N$",A$4000": CALL 4096 +9:SFLAG = 0: GOTO 8
  23. 22  HOME : IF   NOT SFLAG  THEN  VTAB 21: PRINT "UNABLE TO SAVE (NOT YET CAPTURED)": GOSUB 29: GOTO 8
  24. 23  VTAB 23: PRINT "<RETURN> TO CANCEL": VTAB 21: INPUT "SAVE SHAPE TABLE NAMED:";N$: IF   NOT  LEN(N$)  THEN 8
  25. 24  CALL  -958: PRINT : PRINT D$"BSAVE "N$",A$6000,L"( PEEK(0) + PEEK(1) *256) -24576: GOTO 8
  26. 25  TEXT : HOME : PRINT D$"CAT": GOSUB 30: PRINT "ANY KEY:";: GET A$: GOTO 7
  27. 26  PRINT  CHR$(4)"PREFIX": INPUT A$: HOME : VTAB 24: PRINT "<RETURN> TO ESCAPE";: VTAB 22: HTAB 1: PRINT "PREFIX:"A$;: VTAB 22: HTAB 8: CALL  -657:A$ = "": FOR I = 512 TO 767: IF  PEEK(I) < >141  THEN A$ = A$ + CHR$( PEEK(I) -128): NEXT 
  28. 27  ON A$ = "" GOTO 8: PRINT  CHR$(4)"PREFIX"A$: GOTO 8
  29. 29  FOR I = 1 TO 3000: NEXT : RETURN 
  30. 30  FOR I = 1 TO 40: PRINT "-";: NEXT : RETURN 
  31. 31  CALL  -3288
  32. 32  HOME : VTAB 22:I =  PEEK(222)
  33. 33  INVERSE : IF I <14  THEN  PRINT  CHR$(7)" "E$(I)" ERROR "
  34. 34  FOR J = 1 TO 2000 -1999 *(I = 255): NEXT : NORMAL : GOTO 7