home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib41b.dsk / SCREEN.SCRAMBLE.bas < prev    next >
BASIC Source File  |  2023-02-26  |  7KB  |  108 lines
  1. 1  REM  *************************
  2. 2  REM  * SCREEN.SCRAMBLE       *
  3. 3  REM  * BY B. R. CLEMESHA     *
  4. 4  REM  * COPYRIGHT (C) 1991    *
  5. 5  REM  * MINDCRAFT PUBL. CORP. *
  6. 6  REM  * LINCOLN, MA 01773     *  
  7. 7  REM  *************************
  8. 10  REM  * INITIALIZE
  9. 20 D$ =  CHR$(4):G$ =  CHR$(7):H$ =  CHR$(8):J$ =  CHR$(10):K$ =  CHR$(11):M$ =  CHR$(13):U$ =  CHR$(21):ESC$ =  CHR$(27):CODE$ = "123456":SD$ = ",S6,D2": REM  * CTRL-D:BELL:BACK-SPACE:DOWN:UP:RETURN:RIGHT:ESCAPE
  10. 30 CT$ = "CAT,TBIN":F1 = ( PEEK(48896) < >76): IF F1  THEN CT$ = "CATALOG": REM   * FLAG FOR DOS 3.3   
  11. 40  POKE 49247,0: REM  * SINGLE HIRES
  12. 50 SCRAM = 24577: FOR N = 0 TO 55: READ P: POKE SCRAM +N,P: NEXT : ONERR  GOTO 940: REM  * LOAD ML PROGRAM 
  13. 60  FOR N = 1 TO 8: READ A$(N): NEXT N: GOSUB 270: GOSUB 520: IF F1  THEN A$(2) = "2: PRODOS ONLY OPTION": REM  * READ MENU ITEMS
  14. 70  REM  * PRINT MENU SCREEN
  15. 80  PRINT D$"PR#3"M$: HOME :LM = 35:WI = 2: GOSUB 880: PRINT 
  16. 90  FOR N = 1 TO 23: PRINT "|": NEXT :LM = 0:WI = 34: GOSUB 880: VTAB 1: PRINT "        SCREEN SCRAMBLER"M$"   HiRes Graphics Screen Encoder"M$"   Copyright (C) 1991, MindCraft": FOR N = 1 TO 34: PRINT "_";: NEXT 
  17. 100  TEXT : GOSUB 870: GOSUB 820: VTAB 6: FOR N = 1 TO 8: HTAB 4: PRINT A$(N) +M$: NEXT N:N = 1: GOTO 160
  18. 110  REM  * MENU ROUTINE
  19. 120 M =  VAL(KE$): IF M >0  AND M <9  THEN N = M +(M = 2) *F1: GOTO 160
  20. 130  IF KE$ = K$  OR KE$ = U$  THEN N = N -1 -(N = 3) *F1: IF N <1  THEN N = 8
  21. 140  IF KE$ = J$  OR KE$ = H$  THEN N = N +1 +(N = 1) *F1: IF N >8  THEN N = 1
  22. 150  IF KE$ = M$  THEN  ON N GOTO 200,560,330,310,370,540,170,900
  23. 160  GOSUB 820: GOSUB 870: HTAB 4: VTAB (4 +2 *N): INVERSE : PRINT A$(N);: NORMAL : GET KE$: HTAB 4: PRINT A$(N);: GOTO 120
  24. 170  GOSUB 800: GOSUB 820
  25. 180  GET KE$: TEXT : GOTO 160
  26. 190  REM  * GET SLOT AND DRIVE NUMBERS
  27. 200  GOSUB 820: PRINT " SLOT #: ";: GET KE$:: IF KE$ <"8"  AND KE$ >"0"  THEN SD$ = ",S" +KE$: GOTO 230
  28. 210  IF KE$ = ESC$  THEN 260
  29. 220  PRINT G$: GOTO 200
  30. 230  GOSUB 820: PRINT " DRIVE 1/2 ? ";: GET KE$: IF KE$ <"3"  AND KE$ >"0"  THEN SD$ = SD$ +",D" +KE$: GOSUB 270: GOTO 260: REM  * SET SLOT AND DRIVE
  31. 240  IF KE$ = ESC$  THEN 260
  32. 250  PRINT G$: GOTO 230
  33. 260  GOSUB 820: GOTO 160
  34. 270  IF F1 = 0  THEN P$ = "": PRINT D$"PREFIX /": REM  * CLEAR PREFIX
  35. 280  IF   NOT F1  THEN LM = 14:WI = 20: GOSUB 880:TM = 7:BM = 13: GOSUB 860: HTAB 16: HOME : GOSUB 870: GOSUB 850: REM  * CLEAR PREFIX ON SCREEN
  36. 290 A$(1) =  LEFT$(A$(1),14) +SD$: RETURN : REM  * APPEND SLOT AND DRIVE NUMBERS TO A$(1)
  37. 300  REM  * SAVE SCREEN
  38. 310  GOSUB 610: PRINT D$"BSAVE"FILE$",A$2000,L$2000"SD$: GOTO 160
  39. 320  REM  * LOAD SCREEN
  40. 330  GOSUB 610: PRINT D$"BLOAD"FILE$",A$2000"SD$: GOTO 170
  41. 340  REM  * CATALOG DISK
  42. 350  GOSUB 820:LM = 37:WI = 42: GOSUB 880: HOME : PRINT : PRINT D$CT$SD$: GOSUB 870: GOTO 610
  43. 360  REM  * INPUT CODE
  44. 370  GOSUB 820: PRINT " 6 DIGIT KEY ";: FOR J = 1 TO 6:C$(J) =  MID$ (CODE$,J,1): NEXT 
  45. 380  HTAB 14: PRINT CODE$;: HTAB 14:L = 1
  46. 390  GET KE$: IF KE$ = ESC$  THEN  GOSUB 820: GOTO 160
  47. 400  IF KE$ <"0"  OR KE$ >"9"  THEN 430
  48. 410 C$(L) = KE$:L = L +1: IF L >6  THEN L = 6
  49. 420  PRINT KE$;: HTAB L +13: GOTO 390
  50. 430  IF KE$ < >U$  THEN 460
  51. 440 L = L +(L <6)
  52. 450  HTAB L +13: GOTO 390
  53. 460  IF KE$ < >H$  THEN 490
  54. 470 L = L -(L >1)
  55. 480  HTAB L +13: GOTO 390
  56. 490  IF KE$ < >M$  THEN 390
  57. 500 CODE$ = "": FOR J = 1 TO 6:CODE$ = CODE$ +C$(J): NEXT 
  58. 510  GOSUB 520: GOTO 160
  59. 520  GOSUB 820:C1 =  VAL( LEFT$(CO$,2)):C2 =  VAL( MID$ (CO$,3,2)):C3 =  VAL( RIGHT$(CO$,2)):A$(5) =  LEFT$(A$(5),9) +CO$: RETURN : REM  * APPEND CODE TO A$(5)
  60. 530  REM  * ENCODE SCREEN
  61. 540  POKE 6,C1: POKE 7,C2: POKE 8,C3: GOSUB 800: CALL SCRAM: GOTO 170
  62. 550  REM  * GET PREFIX
  63. 560  GOSUB 820: GOSUB 840: INPUT "  PREFIX: ";X$: GOSUB 680:P$ = X$
  64. 570  REM  * SET PREFIX
  65. 580  PRINT D$"PREFIX"P$: VTAB 6: HTAB 18: PRINT  SPC( 6):SD$ = "": GOSUB 590: GOTO 160
  66. 590  GOSUB 280: VTAB 8: FOR M = 0 TO MM: HTAB 15: PRINT "/" +F$(M): NEXT M: GOSUB 820: RETURN 
  67. 600  REM  * GET FILE/PATH NAME
  68. 610  GOSUB 820: GOSUB 840: PRINT : HTAB 13: PRINT "(Enter ? for catalog)";: VTAB 21: PRINT : INPUT " FILE NAME: ";FI$: GOSUB 820: GOSUB 850
  69. 620 F2 = ( LEFT$(FI$,1) = "/"): IF FI$ = "?"  THEN 350: REM  * CATALOG
  70. 630  IF F1  THEN  RETURN : REM  DOS 3.3
  71. 640  IF F2  THEN  GOSUB 270: REM  * FULL PATH NAME SO CLEAR PREFIX
  72. 650  REM  * CHECK PRODOS FILE/PATH NAME
  73. 660 X$ = FI$: GOSUB 680:FI$ = X$: IF F2 = 0  OR P$ < >""  THEN FI$ =  RIGHT$(X$,LN -1)
  74. 670  RETURN 
  75. 680  IF  LEFT$(X$,1) < >"/"  THEN X$ = "/" +X$
  76. 690 LN =  LEN(X$): IF  RIGHT$(X$,1) = "/"  THEN LN = LN -1:X$ =  LEFT$(X$,LN)
  77. 700  REM  * SPLIT PATH NAME INTO SUB-DIRECTORIES
  78. 710 M = 0: FOR J = 1 TO LN: IF  MID$ (X$,J,1) = "/"  THEN P(M) = J:M = M +1
  79. 720  NEXT :MMAX = M -1:P(M) = LN +1
  80. 730  FOR M = 0 TO MMAX:FI$ =  MID$ (X$,P(M) +1,P(M +1) -P(M) -1)
  81. 740  GOSUB 760:F$(M) = FI$: NEXT M: RETURN 
  82. 750  REM  * CHECK PRODOS FILE/DIRECTORY NAME
  83. 760 NF = 1: IF  LEN(FI$) >0  THEN  FOR NC = 1 TO  LEN(FI$):NA =  ASC( MID$ (FI$,NC,1)):NF = ((NA >64  AND NA <91)  OR (NA = 46)  OR (NA >47  AND NA <58  AND NC >1))  AND NF = 1: NEXT : REM  CHECK FILE NAME
  84. 770  IF  LEN(FI$) >15  OR NF = 0  OR  LEFT$(FI$,1) = "."  THEN  GOSUB 820: PRINT G$"   *  INVALID NAME    ";: GET KE$: GOSUB 820: GOTO 160
  85. 780  RETURN 
  86. 790  REM  * TURN ON HGR
  87. 800  POKE 49232,0: POKE 49234,0: POKE 49239,0: RETURN 
  88. 810  REM  * CLEAR INPUT LINE
  89. 820  VTAB 21: PRINT : PRINT  SPC( 34): PRINT : PRINT  SPC( 34): VTAB 21: PRINT : RETURN 
  90. 830  REM  * SET TEXT WINDOW
  91. 840 TM = 22:BM = 23: GOTO 860
  92. 850 TM = 0:BM = 23
  93. 860  POKE 34,TM: POKE 35,BM: RETURN : REM  * SET VERTICAL
  94. 870 LM = 0:WI = 35
  95. 880  POKE 32,LM: POKE 33,WI: RETURN : REM  * SET HORIZONTAL
  96. 890  REM  * Q<CTRL-I>UIT
  97. 900  GOSUB 820: PRINT "Sure you want to quit ? ";: GET KE$: IF KE$ = "Y"  OR KE$ = "y"  THEN WI = 79: GOSUB 880: HOME : END 
  98. 910  IF KE$ < >"N"  AND KE$ < >"n"  THEN 900
  99. 920  GOSUB 820: GOTO 160
  100. 930  REM  * ERROR HANDLING ROUTINE
  101. 940 ER =  PEEK(222):MSG$ = "   *  ANY KEY TO CONTINUE "
  102. 950  IF ER = 6  THEN MSG$ = "   *  PATH NOT FOUND      "
  103. 960  IF ER = 13  THEN MSG$ = "   *  WRONG FILE TYPE     "
  104. 970  GOSUB 840: GOSUB 870: GOSUB 820: VTAB 22: HTAB 1: PRINT G$MSG$;: GET KE$: GOSUB 820: GOTO 100
  105. 980  REM  * DATA STATEMENTS
  106. 990  DATA  169,0,133,206,169,32,133,207,169,170,56,101,6,32,30,96,101,7,32,30,96,101,8
  107. 1000  DATA  32,30,96,76,11,96,133,9,160,0,177,206,69,9,145,206,230,206,208,10,230,207,165,207,201,64,208,2,40,40,165,9,96
  108. 1010  DATA  "1: SLOT/DRIVE:","2: PREFIX:","3: LOAD","4: SAVE","5: CODE: ","6: SCRAMBLE/UNSCRAMBLE","7: VIEW","8: QUIT"