PROGRAM LISTING: 89-08/SUPERHOP.ACT

;SUPERHOP
;BY DOUGLAS SKRECKY
;(C)1989, ANTIC PUBLISHING INC.
;
DEFINE BEGIN="DO",ENDWHILE="OD",
       ENDIF="FI",END="OD"
;
MODULE
 CARD ARRAY LINE(192)
 BYTE ARRAY RSH3(320),FILENAME(16)
 BYTE KEY=764,DISPLAY=559,IOTYPE=850,
      SCREEN_SIZE,R1,R2,Z,MENUKEY,
      CLEAR,LARGER,SMALLER,UP,DOWN,
      LEFT,RIGHT,SPACEBAR,LOAD,SAVE,
      CREATE,DEMO,DEMOMODE,ON,OFF,PY
 INT  CX,CY,X,Y,XX,I,J,IC,JC,X0,Y0
 CARD BUFFER_ADDRESS=852,COUNT,PX,
      BUFFER_LENGTH=856,SCREEN=88
;
PROC INITIALIZE_PLOT()              
 GRAPHICS(8+16) SETCOLOR(2,0,0)
 FOR PY=0 TO 191 BEGIN
   LINE(PY)=SCREEN+40*PY
 END
 FOR PX=0 TO 319 BEGIN
   RSH3(PX)=PX RSH 3
 END
RETURN
;
PROC PLOT(CARD PX,BYTE PY)         
 BYTE POINTER PT           
 BYTE ARRAY ON=[128 64 32 16 8 4 2 1]
 PT=LINE(PY) + RSH3(PX)
 PT^==%ON(PX&7)
RETURN
;
PROC CIO=$E456(BYTE AREG,XREG)[]
;
PROC DISKDIR()
 BYTE ARRAY FILES(20)
 GRAPHICS(0)
 SETCOLOR(2,9,0) SETCOLOR(4,9,0)
 CLOSE(1) OPEN(1,"D1:*.*",6,0)
 PRINTE("           ÄÉÓË ÄÉÒÅÃÔÏÒÙ           ")
 INPUTSD(1,FILES) 
 WHILE FILES(16)<>'S BEGIN
   PRINTF("%S%S",FILES,"  ")
   INPUTSD(1,FILES) 
 ENDWHILE
 PRINTF("%E%S%S%E","           ",FILES)
 CLOSE(1)
RETURN
;
PROC CHOOSE_FILE()
 BYTE ARRAY TEMP(16)
 PRINT("==>")
 ZERO(FILENAME,16)
 FILENAME(1)='D
 FILENAME(2)='1
 FILENAME(3)=':
 KEY=CLEAR INPUTS(TEMP)
 SASSIGN(FILENAME,TEMP,4,16)
RETURN
;
PROC LOAD_FRACTAL()
 DISKDIR()
 PRINTE("  ÔÙÐÅ ÉΠÆÉÌÅÎÁÍÅ ÔÏ ÌÏÁÄ ÐÉÃÔÕÒÅ  ")
 CHOOSE_FILE()
 CLOSE(1)
 OPEN(1,FILENAME,4,0)
 GRAPHICS(8+16) SETCOLOR(2,0,0)
 IOTYPE=7
 BUFFER_ADDRESS=SCREEN
 BUFFER_LENGTH=7680
 CIO(0,16)
 CLOSE(1)
 KEY=CLEAR
 DO UNTIL KEY=LOAD OR KEY=DEMO OR
  KEY=CREATE OR KEY=MENUKEY
 END
 INITIALIZE_PLOT()              
RETURN
;
PROC SAVE_FRACTAL()
 BYTE ARRAY SAVESCREEN(7680)
 MOVEBLOCK(SAVESCREEN,SCREEN,7680)
 DISKDIR()
 PRINTE("  ÔÙÐÅ ÉΠÆÉÌÅÎÁÍÅ ÔÏ ÓÁÖÅ ÐÉÃÔÕÒÅ  ")
 CHOOSE_FILE()
 CLOSE(1)
 OPEN(1,FILENAME,8,0)
 IOTYPE=11
 BUFFER_ADDRESS=SAVESCREEN
 BUFFER_LENGTH=7680
 CIO(0,16)
 CLOSE(1)
 INITIALIZE_PLOT()              
 MOVEBLOCK(SCREEN,SAVESCREEN,7680)
RETURN
;
PROC MENU()
 GRAPHICS(0) POKE(752,1)
 SETCOLOR(2,9,0) SETCOLOR(4,9,0)
 PRINT("               ÓÕÐÅÒÈÏС              ")
 PUTE() PUTE() PUTE() PUTE()
 PRINTE(" Press Í To Return To THIS Íenu")
 PRINTE(" Press Ä To Turn Äemomode On")
 PRINTE(" Press à To Ãreate a Fractal")
 PRINTE(" Press Ì To Ìoad a Fractal Picture")
 PRINTE(" Press Ó To Óave a Fractal Picture")
 PRINTE(" Press ¼ To Zoom-out For a Wider View")
 PRINTE(" Press ¾ To Zoom-in Or Magnify")
 PRINTE(" Use Cursor Keys To Move Fractal")
 PRINTE(" Press Spacebar To Toggle Display")
 PUTE() PUTE() PUTE() PUTE()
 PRINTE("       BY Douglas Skrecky")
 KEY=CLEAR
 WHILE KEY=CLEAR OR KEY=SAVE OR KEY=SPACEBAR
 BEGIN ENDWHILE
 INITIALIZE_PLOT()              
RETURN
;
PROC SETUP()
 CLEAR=255 CREATE=18 DEMO=58
 MENUKEY=37 LARGER=55 SMALLER=54
 UP=14 DOWN=15 LEFT=6 RIGHT=7
 LOAD=0 SAVE=62 SPACEBAR=33
 ON=34 OFF=0 DEMOMODE=OFF
RETURN

PROC NEW_PARAMETERS()
 BYTE ATTRACT=77
 ATTRACT=0
 X=0 Y=0 Z=0 COUNT=0 X0=0 Y0=0
 CX=200+2*RAND(0)+RAND(0)
 CY=200+2*RAND(0)+RAND(0)
 R1=1+RAND(5) R2=2+RAND(4)
 JC=96 IC=160 SCREEN_SIZE=6 
RETURN
;
PROC DRAW_FRACTAL()
 BYTE ATTRACT=77
 ATTRACT=0
 IF Y>=0 THEN J=JC+ (Y RSH SCREEN_SIZE)
  ELSE J=JC- (-Y RSH SCREEN_SIZE)
 ENDIF
 IF X>=0 THEN XX=Y+((X RSH R1)+CX)
   IF J>0 AND J<191 THEN I=IC+(X RSH SCREEN_SIZE)
    IF I>0 AND I<319 THEN PLOT(I,J)
    ENDIF
   ENDIF
  ELSE XX=Y+((-X RSH R2)-CX)
   IF J>0 AND J<191 THEN I=IC-(-X RSH SCREEN_SIZE)  
    IF I>0 AND I<319 THEN PLOT(I,J)
    ENDIF
   ENDIF
 ENDIF
 Y=(CY-X) Z==+1 X=XX
 IF Z=0 THEN Y==-7
 ENDIF
 IF DEMOMODE=ON THEN COUNT==+1
  IF COUNT>15000 THEN KEY=DEMO
  ENDIF
 ENDIF
RETURN
;
PROC CHANGE_PARAMETERS()
 IF KEY=MENUKEY THEN MENU() INITIALIZE_PLOT() 
 ENDIF
 IF KEY=SPACEBAR THEN 
  IF DISPLAY=OFF THEN DISPLAY=ON
   ELSE DISPLAY=OFF
  ENDIF
  KEY=CLEAR RETURN
 ENDIF
 IF KEY=SAVE THEN SAVE_FRACTAL() RETURN
 ENDIF
 IF KEY=LOAD THEN LOAD_FRACTAL() NEW_PARAMETERS() RETURN
 ENDIF
 IF KEY=DEMO THEN DEMOMODE=ON NEW_PARAMETERS()
  ELSE DEMOMODE=OFF
 ENDIF
 IF KEY=CREATE THEN NEW_PARAMETERS()
 ENDIF
 IF KEY=LARGER AND SCREEN_SIZE>1 THEN SCREEN_SIZE==-1 
  IC=2*IC-162 JC=2*JC-96
 ENDIF
 IF KEY=SMALLER AND SCREEN_SIZE<8 THEN SCREEN_SIZE==+1
  IC=(162+IC)/2 JC=(96+JC)/2
 ENDIF
 IF KEY=LEFT THEN  IC==-10
 ENDIF
 IF KEY=RIGHT THEN IC==+10
 ENDIF
 IF KEY=UP THEN    JC==-10
 ENDIF
 IF KEY=DOWN THEN  JC==+10
 ENDIF
 ZERO(SCREEN,7680)
 X=0 Y=0 Z=0 COUNT=0
 KEY=CLEAR
RETURN
;
PROC HOPDEMO()
 SETUP()
 MENU()
 NEW_PARAMETERS()
 BEGIN
   WHILE KEY=CLEAR BEGIN
     DRAW_FRACTAL()
   ENDWHILE
 CHANGE_PARAMETERS()
 END
RETURN
;