' This program creates visual representations of the data from the StarProbe
' mathematical model. Its structure and organization have been borrowed from
' DeluxDraw (by Rich Wirch).
'
' Allocate enough memory to save entire screen into an array
DEF FNArraySize& = 3+INT((BobRight+16)/16)*(BobBottom+1)*Depth
  BobRight = 600: BobBottom = 187 : Depth = 4
  Size& = FNArraySize& * 2
  IF FRE(0) AND FRE(-1) < Size& THEN PRINT "Not enough memory":END

  IF FRE(0) < Size& THEN 
    CLEAR,Size&+24000
    DEF FNArraySize& = 3+INT((BobRight+16)/16)*(BobBottom+1)*Depth
  END IF
  BobRight = 600: BobBottom = 187 : Depth = 4

DECLARE FUNCTION SetDrMd LIBRARY ' Set the Drawing Mode
DECLARE FUNCTION Move LIBRARY    ' Move the Plotting Position
DECLARE FUNCTION Flood LIBRARY   ' Flood Fill an Area

DEFINT a-z
DIM SPdata!(1,8) 'Dummy decl; redone when loading data
DIM SelData(8)
DIM Dmin!(8),Dmax!(8),Dtitle$(8),Dcol(8)
MaxVar=7

GOSUB Initialize
GOSUB ReadData

'  Main loop - always return here or at next statement
'Main:
 'WHILE l<>0: l = MOUSE(0): WEND
Main2:
 l = MOUSE(0):x = MOUSE(3):y = MOUSE(4)
 y=y-1  'Fix Y to align better with pointer
 Mbar = MENU(0)
 IF Mbar > 0 THEN
   Mitem = MENU(1)
   IF Mbar = 1 THEN ' actions
     ON Mitem GOSUB  ReadData, DataSummary, DrawGraph, Picture, ClearScreen,  Quit
   ELSEIF Mbar = 2 THEN 'options
     ON Mitem GOSUB PlotByMass, PlotByRadius, SmallPicts, LargePict, BaseSemiLog, BaseNormal
   ELSEIF Mbar = 3 THEN 'data selection
     GOSUB SelectData
   END IF
 END IF

 IF x<0 OR x>WWIDTH OR y<0 OR y>HEIGHT GOTO Main2
 IF l <> 0 THEN GOSUB LeftButton
 GOTO Main2   

LeftButton:
  IF x < 220 OR x > 290 THEN RETURN
  IF y > 80 THEN RETURN
  Mitem = (y\10) + 1
  IF Mitem > 8 THEN RETURN
  GOSUB SelectData
  RETURN
 
 ' ----------------- Subroutines -----------------
'
ClearScreen:
  LINE (0,0)-(WWIDTH,HEIGHT),1,bf 'clear screen
  RETURN
'
PlotByMass:
  IndVar = 0
  MENU 2,1,2
  MENU 2,2,1
  RETURN
'
PlotByRadius:
  IndVar = 4
  MENU 2,1,1
  MENU 2,2,2
  RETURN
'
SmallPicts:
  PictSize=0
  MENU 2,4,1
  MENU 2,3,2
  RETURN
'
LargePict:
  PictSize=1
  MENU 2,4,2
  MENU 2,3,1
  RETURN
'
BaseSemiLog:
  IF SemiLog=0 THEN
    GOSUB ConvertToLog   
  END IF
  GOSUB EvaluateRanges
  MENU 2,5,2
  MENU 2,6,1
  SemiLog=1
  RETURN
'
BaseNormal:
  IF SemiLog=1 THEN
    GOSUB ConvertToNormal
  END IF
  GOSUB EvaluateRanges
  MENU 2,5,1
  MENU 2,6,2
  SemiLog=0
  RETURN
'
DrawGraph:
  GOSUB Outline
  VarCount = 0
  FOR i = 0 TO MaxVar
    IF SelData(i) = 1 THEN
      x = 10
      IF SPdata!(0,i) > SPdata!(GradSteps,i) THEN y=0 ELSE y=180
      DepVar = i
      VarCount = VarCount + 1
      COLOR Dcol(DepVar),1
      GOSUB Description
      GOSUB PlotIt
    END IF
  NEXT
  GOSUB ResetDataMenu
  FOR i = 0 TO MaxVar
    SelData(i) = 0
  NEXT
  RETURN
'
Outline:
  GOSUB ClearScreen
  COLOR 3,1
  LINE (10,1)-(10,180),3 'vert axis
  LINE (10,180)-(410,180),3 'horiz axis
  FOR x=10 TO 410 STEP 40
    LINE (x,182)-(x,178),3'horiz hash marks
  NEXT
  CALL Move&(RP&, 430,180)
  PRINT Dtitle$(IndVar);
  RETURN
'
PlotIt:
  OldX=x : OldY=y
  IndScale!= (Dmax!(IndVar) - Dmin!(IndVar))/400!
  DepScale!= (Dmax!(DepVar) - Dmin!(DepVar))/180!
  FOR Ind = 0 TO GradSteps
    x = 10 +  ((SPdata!(Ind,IndVar)-Dmin!(IndVar))/IndScale!)
    y = 180 - ((SPdata!(Ind,DepVar)-Dmin!(DepVar))/DepScale!)
    LINE (OldX,OldY)-(x,y)
    OldX=x : OldY=y
  NEXT
  RETURN
'
Description:
  z = 20 + (VarCount*10)
  CALL Move&(RP&, 450, z)
  PRINT Dtitle$(DepVar);
  RETURN
'
PictDesc:
  zy = 10 + ((VarCount\4)*110)
  zx = 40 + ((VarCount MOD 4)*130)
  CALL Move&(RP&, zx, zy)
  PRINT Dtitle$(DepVar);
  RETURN
'
Picture:
  VarCount=0
  GOSUB ClearScreen
  FOR i = 2 TO 15' borrow most of the palette
    PALETTE i,1!,i/15!,i/15! ' red based
  NEXT
  IF PictSize=1 THEN rmult = 4 ELSE rmult=1
  done=0
  FOR DepVar=0 TO MaxVar
   IF SelData(DepVar)=1 THEN
     IF done = 0 THEN GOSUB DoPict
     IF PictSize=1 THEN done=1
     VarCount=VarCount+1
   END IF
  NEXT
  GOSUB WaitForMouse
  SelData(DepVar)=0:GOSUB ResetDataMenu
  GOSUB SetPalette
  RETURN
'
DoPict:
  IF PictSize=1 THEN
    GOSUB Description
  ELSE
    GOSUB PictDesc
  END IF
  DepScale!= (Dmax!(DepVar) - Dmin!(DepVar))/13!
  r=1
  min!=Dmin!(DepVar)
  IF PictSize=1 THEN
    x0 = WWIDTH\2
    y0 = HEIGHT\2
  ELSE
    x0 = 70 + ((VarCount MOD 4)*130)
    y0 = 40 + ((VarCount\4)*110)
  END IF
  FOR j = 0 TO GradSteps
    rnew=r+rmult
    hue = 2 + (SPdata!(j,DepVar)-min!)/DepScale!    
    FOR i = r TO rnew    
      CIRCLE (x0,y0),i,hue
    NEXT
    r=rnew
  NEXT
RETURN
'
WaitForMouse:
  l = MOUSE(0)
  WHILE MOUSE(0)=0:WEND
  RETURN
'
SelectData:
  i=Mitem-1
  ON Mitem GOSUB Smass,Spress,Stemp,Slum,Srad,Sdens,Sopcty,Senergy
  IF SelData(i)=0 THEN SelData(i)=1 ELSE SelData(i)=0
  RETURN  
'
Smass:
  IF SelData(i) = 1 THEN
    MENU 3,1,1
  ELSE
    MENU 3,1,2
  END IF
  RETURN
Spress:
  IF SelData(i) = 1 THEN
    MENU 3,2,1
  ELSE
    MENU 3,2,2
  END IF
  RETURN
Stemp:
  IF SelData(i) = 1 THEN
    MENU 3,3,1
  ELSE
    MENU 3,3,2
  END IF
  RETURN
Slum:
  IF SelData(i) = 1 THEN
    MENU 3,4,1
  ELSE
    MENU 3,4,2
  END IF
  RETURN
Srad:
  IF SelData(i) = 1 THEN
    MENU 3,5,1
  ELSE
    MENU 3,5,2
  END IF
  RETURN
Sdens:
  IF SelData(i) = 1 THEN
    MENU 3,6,1
  ELSE
    MENU 3,6,2
  END IF
  RETURN
Sopcty:
  IF SelData(i) = 1 THEN
    MENU 3,7,1
  ELSE
    MENU 3,7,2
  END IF
  RETURN
Senergy:
  IF SelData(i) = 1 THEN
    MENU 3,8,1
  ELSE
    MENU 3,8,2
  END IF
  RETURN

ReadData:
  PENDING=4: CANCEL=FALSE: GOSUB GetName ' get a filename
  IF FileName$<>"" AND (NOT CANCEL) THEN 
    OPEN FileName$ FOR INPUT AS 1 LEN=1024
  ELSE
    PENDING = 0
    RETURN
  END IF
  FOR i = 0 TO MaxVar
    Dmin!(i) = 3E+38
    Dmax!(i) =-1!
  NEXT
  INPUT #1,steps
  ERASE SPdata!
  DIM SPdata!(steps,8)
  GradSteps = steps - 1
  FOR i = 0 TO GradSteps
    FOR j = 0 TO MaxVar
      INPUT #1,SPdata!(i,j)
    NEXT
  NEXT
  CLOSE #1
  SemiLog=-1 ' bypass conversion
  GOSUB BaseNormal
  PENDING = 0
  RETURN
'
EvaluateRanges:
  FOR i = 0 TO GradSteps
    FOR j = 0 TO MaxVar
      IF SPdata!(i,j) > Dmax!(j) THEN Dmax!(j) = SPdata!(i,j)
      IF SPdata!(i,j) < Dmin!(j) THEN Dmin!(j) = SPdata!(i,j)
    NEXT               
  NEXT
  GOSUB DataSummary
  RETURN
'
ConvertToLog:
  cv! = .4343
  FOR i = 0 TO GradSteps
    FOR j = 0 TO MaxVar
      SPdata!(i,j) = cv!*LOG(SPdata!(i,j))
    NEXT
  NEXT
  RETURN
'
ConvertToNormal:
  cv! = .4343
  FOR i = 0 TO GradSteps
    FOR j = 0 TO MaxVar
      SPdata!(i,j) = EXP((SPdata!(i,j)/cv!))
    NEXT
  NEXT
  RETURN
'
DataSummary:
  GOSUB ClearScreen
  COLOR 3,1
  CALL Move&(RP&, 150,20): PRINT "Data";
  CALL Move&(RP&, 260,20): PRINT "Minimum";
  CALL Move&(RP&, 380,20): PRINT "Maximum";
  FOR DepVar = 0 TO MaxVar
    COLOR Dcol(DepVar),1
    y = 40 + (DepVar*10)
    CALL Move&(RP&, 150,y):  PRINT Dtitle$(DepVar);
    CALL Move&(RP&, 250,y):  PRINT Dmin!(DepVar);
    CALL Move&(RP&, 370,y):  PRINT Dmax!(DepVar);
  NEXT
  RETURN

'  File name requestor routine.  We'll be looking for mouse
'  clicks as well as character input, so use GET versus INPUT
'  to receive the file name. 
'
GetName:
  BobRight = 190: BobBottom = 80
  Size&=FNArraySize& \2
  DIM SavReq&(Size&)
  GET( 50,16)-(240,96), SavReq&
  i= 40  'Pop out the requestor box
    LINE(90-i,56-i)-(200+i,56+i),2,bf
  LINE(50,16)-(240,96),3,b
  COLOR 1,2:CALL Move&(RP&,53,35): PRINT Prompt$;
  LINE(85,50)-(202,62),3,b
  '  This little box is the "cursor", in yellow
  CURS=88: LINE(CURS,52)-(CURS+7,60),3,bf
  LINE(166,74)-(219,86),3,b
  COLOR 3,1: CALL Move&(RP&, 169,83): PRINT "Cancel";
  CALL Move&(RP&, 60,40): PRINT "Enter data file name";
  
  '  Allowable file names (change it to suit your taste):
  '     First character must be a letter
  '     Remaining chars may be letters, numbers or . or -
  '     Maximum of 13 chars 
  '     No two . or - may be adjoining
  '     No embedded blanks allowed
  '
  C$=INKEY$: WHILE C$<>"": C$=INKEY$: WEND   'Clear any queued input
  FileName$=""

Loop:
 C$=INKEY$: l=MOUSE(0): x=MOUSE(1):y=MOUSE(2)
 IF l<>0 THEN
   WHILE l<>0: l=MOUSE(0): x=MOUSE(1):y=MOUSE(2): WEND  'Wait for button release
   '  See if we're in the CANCEL box
   y=y-1  'For better pointer alignment
   IF x>165 AND x<220 AND y>73 AND y<87 THEN 
     CANCEL=TRUE: PUT(50,16),SavReq&,PSET: ERASE SavReq&: RETURN
   END IF
 END IF
 IF C$="" THEN GOTO Loop
 'LINE(75,69)-(183,91),2,b
 IF LEN(FileName$)=0 THEN IF C$<"A" AND ASC(C$)<>13 GOTO Loop  'This must be the first character
 IF ASC(C$) = 13 THEN   '13=Carriage return
   PUT( 50,16),SavReq&,PSET: ERASE SavReq&
   RETURN
 END IF
 IF ASC(C$) = 8 THEN   '8=Backspace
    FileName$=LEFT$(FileName$,LEN(FileName$)-1)  'Shorten name
    LINE(CURS,52)-(CURS+7,60),2,bf  'Back up cursor
    CURS=CURS-8: LINE(CURS,52)-(CURS+7,60),3,bf
    GOTO Loop
 END IF
 IF LEN(FileName$) >= 13 GOTO Loop  'No more letters
 IF RIGHT$(FileName$,1)="." OR RIGHT$(FileName$,1)="-" GOTO Loop
 IF ASC(C$)=8 THEN GOTO Loop   'Superfluous backspace
 IF C$<"0" OR (C$>"9" AND C$<"A") GOTO Loop
 IF (C$>"Z" AND C$<"a") OR C$>"z" GOTO Loop
 '  Add this letter and advance cursor
 FileName$= FileName$ + C$
 LINE(CURS,52)-(CURS+7,60),2,bf
 COLOR 1,2: CALL Move&(RP&,0,59): PRINT PTAB(CURS);C$;
 CURS=CURS+8: LINE(CURS,52)-(CURS+7,60),3,bf
 GOTO Loop  'Get another character

InitFile:
  FileName$=""
  BobRight=  WWIDTH-1
  BobBottom= HEIGHT-1
  PlanePick= MaxColor
  RETURN 

'
Quit:
   LIBRARY CLOSE
   WINDOW CLOSE 2
   SCREEN CLOSE 1
   MENU RESET
   END 

'--------------------------------------------------
Initialize:

  Depth = 4 'Depth =0
 'WHILE Depth < 2 or Depth > 5
 '   INPUT "Select number of bit planes (2-5) ",Depth
 'WEND

  RES=631  'RES=0
  IF Depth = 5 THEN
    RES = 311
  ELSE
    WHILE RES=0
      INPUT "Select resolution (Hi/Lo) ", C$
      C$=LEFT$(C$,1)
      IF C$="H" OR C$="h" THEN RES=631
      IF C$="L" OR C$="l" THEN RES=311
    WEND
  END IF

  DIM PAT1%(1),PAT2%(1),PCan!(31,3) : DIM BobArray(1)

  RES2=RES/320   'For hi-res aspect ratio for circles
  IF RES < 400 THEN scrmode = 1 ELSE scrmode = 2  
  SCREEN 1, scrmode*320, 200, Depth, scrmode
  CLS
  WINDOW 2,"StarProbe Analyzer",(0,0)-(RES,186),0,1
  WINDOW OUTPUT 2

  TRUE=-1: FALSE=0   'For convenience
  IF Depth = 5 THEN COLBOX = 6 ELSE COLBOX = 10
  '  Set colors for Paintbox
  PCan!(0,0)= 6/15: PCan!(0,1)= 6/15: PCan!(0,2)= 6/15   'Dark grey
  PCan!(1,0)= 0/15: PCan!(1,1)= 0/15: PCan!(1,2)= 0/15   'Black
  PCan!(2,0)=10/15: PCan!(2,1)=10/15: PCan!(2,2)=10/15   'Light grey
  PCan!(3,0)=15/15: PCan!(3,1)=15/15: PCan!(3,2)=15/15   'White
  PCan!(4,0)=15/15: PCan!(4,1)= 9/15: PCan!(4,2)= 9/15   'Pink
  PCan!(5,0)=15/15: PCan!(5,1)= 6/15: PCan!(5,2)= 6/15   'Light Red
  PCan!(6,0)=15/15: PCan!(6,1)= 2/15: PCan!(6,2)= 2/15   'Red
  PCan!(7,0)=12/15: PCan!(7,1)= 0/15: PCan!(7,2)= 14/15  'Purple
  PCan!(8,0)= 7/15: PCan!(8,1)=13/15: PCan!(8,2)= 15/15  'Light Blue
  PCan!(9,0)= 8/15: PCan!(9,1)= 8/15: PCan!(9,2)= 15/15  'Med.  Blue
  PCan!(10,0)= 4/15:PCan!(10,1)= 4/15:PCan!(10,2)=15/15  'Dark  Blue
  PCan!(11,0)= 0/15:PCan!(11,1)=14/15:PCan!(11,2)= 13/15 'Aqua
  PCan!(12,0)= 8/15:PCan!(12,1)=12/15:PCan!(12,2)= 8/15  'Light Green
  PCan!(13,0)= 4/15:PCan!(13,1)=12/15:PCan!(13,2)= 4/15  'Med.  Green
  PCan!(14,0)= 0/15:PCan!(14,1)=15/15:PCan!(14,2)= 0/15  'Dark  Green
  PCan!(15,0)=15/15:PCan!(15,1)=15/15:PCan!(15,2)= 2/15  'Yellow

  PCan!(16,0)=0/15: PCan!(16,1)= 4/15: PCan!(16,2)= 4/15   'aquas
  PCan!(17,0)=0/15: PCan!(17,1)= 6/15: PCan!(17,2)= 6/15  
  PCan!(18,0)=0/15: PCan!(18,1)= 8/15: PCan!(18,2)= 8/15   
  PCan!(19,0)=0/15: PCan!(19,1)=10/15: PCan!(19,2)= 10/15  
  PCan!(20,0)=0/15: PCan!(20,1)=12/15: PCan!(20,2)= 12/15  

  PCan!(21,0)=15/15: PCan!(21,1)=15/15: PCan!(21,2)= 2/15   'yellows
  PCan!(22,0)=15/15: PCan!(22,1)=15/15: PCan!(22,2)= 4/15  
  PCan!(23,0)=15/15: PCan!(23,1)=15/15: PCan!(23,2)= 6/15  
  PCan!(24,0)=15/15: PCan!(24,1)=15/15: PCan!(24,2)= 8/15 
  PCan!(25,0)=15/15: PCan!(25,1)=15/15: PCan!(25,2)= 10/15  
  PCan!(26,0)=15/15: PCan!(26,1)=15/15: PCan!(26,2)= 12/15

  PCan!(27,0)= 2/15: PCan!(27,1)= 15/15:PCan!(27,2)= 2/15   'greens
  PCan!(28,0)= 4/15: PCan!(28,1)= 15/15:PCan!(28,2)= 4/15
  PCan!(29,0)= 6/15: PCan!(29,1)= 15/15:PCan!(29,2)= 6/15
  PCan!(30,0)= 8/15: PCan!(30,1)= 15/15:PCan!(30,2)= 8/15 
  PCan!(31,0)= 10/15:PCan!(31,1)= 15/15:PCan!(31,2)= 10/15 

  GOSUB SetPalette

  LIBRARY "graphics.library"
  RP& = WINDOW(8)               ' Pointer to the Raster Port
  W=WINDOW( 2): H=WINDOW(3): WWIDTH=W: HEIGHT=H

  '  Menu items
  MENU 1,0,1,"AstroProject"
  MENU 1,1,1,"Read Data   "
  MENU 1,2,1,"Data Summary"
  MENU 1,3,1,"Draw Graphs "
  MENU 1,4,1,"Picture     "
  MENU 1,5,1,"Clear Screen"
  MENU 1,6,1,"Quit        "

  MENU 2,0,1,"Options"
  MENU 2,1,1,"   Plot By Mass  "
  MENU 2,2,1,"   Plot By Radius"
  MENU 2,3,1,"   Small Pictures"
  MENU 2,4,1,"   Large Picture "
  MENU 2,5,1,"   Semi-Log Base "
  MENU 2,6,1,"   Regular Base  "

  MENU 3,0,1,"Select Data"
  GOSUB SetDataMenu

  MENU 4,0,0,""  ' not used, overlays the fourth menu in amigabasic

'   Set default options
  GOSUB PlotByRadius
  GOSUB SmallPicts

  Dtitle$(0) = "Mass"
  Dtitle$(1) = "Pressure"
  Dtitle$(2) = "Temperature"
  Dtitle$(3) = "Luminosity"
  Dtitle$(4) = "Radius"
  Dtitle$(5) = "Density"
  Dtitle$(6) = "Opacity"
  Dtitle$(7) = "EnergyRate"

  Dcol(0)=3 : Dcol(1)=7 : Dcol(2)=6 : Dcol(3)=11
  Dcol(4)=10: Dcol(5)=0 : Dcol(6)=2 : Dcol(7)=15

 '  Initialize starting values
 TextX = 47: TextY = 8
 COL = 1 : LASTCOLOR = 0 : MaxColor = 2^Depth - 1     ' Color info
 Style = 2: DY = Style - 1: DX = 2 * DY * RES2        ' Style info
 SelMass=0:SelPress=0:SelTemp=0:SelLum=0:SelRad=0:SelDens=0
 SelOpcty=0:SelEnergy=0
 PI!=3.14159
 GOSUB InitFile

 l = MOUSE(0): x = MOUSE(1): y = MOUSE(2):
 RETURN
'
SetDataMenu:
  MENU 3,1,1,"   Mass   "
  MENU 3,2,1,"   Press  "
  MENU 3,3,1,"   Temp   "
  MENU 3,4,1,"   Lum    "
  MENU 3,5,1,"   Radius "
  MENU 3,6,1,"   Density"
  MENU 3,7,1,"   Opacity"
  MENU 3,8,1,"   Energy "
  RETURN
ResetDataMenu:
  MENU 3,1,1
  MENU 3,2,1
  MENU 3,3,1
  MENU 3,4,1
  MENU 3,5,1
  MENU 3,6,1
  MENU 3,7,1
  MENU 3,8,1
  RETURN
'
SetPalette:
  FOR i=0 TO 2^Depth-1: PALETTE i, PCan!( i,0), PCan!( i,1), PCan!( i,2): NEXT
  RETURN