DECLARE SUB dc ()
DECLARE SUB radsec ()
DECLARE SUB degsec ()
DECLARE SUB hertz ()
DECLARE SUB summate ()
DECLARE SUB seconds ()
DECLARE SUB radians ()
DECLARE SUB degrees ()
DECLARE SUB clearscreen ()
DECLARE SUB clearmem ()
DECLARE SUB newsin ()
DECLARE SUB showpeak ()
DECLARE SUB savebmp ()
DECLARE SUB FourBIT (x1%, y1%, x2%, y2%, FileNAME$)


'This is "sine sum" by Louis Dudzik.

' this sets up the screen
CLS
SCREEN 12
VIEW (0, 0)-(639, 400)
WINDOW (0, 10.1)-(639, -10.1)
VIEW PRINT 26 TO 30
LINE (0, 0)-(640, 0)
LINE (0, 10)-(0, -10)


'this sets up the memory
'shared means this array is shared by all subroutines
'single means precision of each entry is 32 bits long and floating decimal point
DIM SHARED sum(0 TO 640)  AS SINGLE
DIM SHARED peak(0 TO 640) AS SINGLE
DIM SHARED pi AS SINGLE
pi = 3.141593
DIM SHARED frq  AS SINGLE
DIM SHARED dly   AS SINGLE
DIM SHARED dcv  AS SINGLE
DIM SHARED amp   AS SINGLE
DIM SHARED tic   AS INTEGER
DIM SHARED angle     AS SINGLE
DIM SHARED angle1   AS SINGLE
DIM SHARED xxx     AS INTEGER
DIM SHARED xxx1   AS INTEGER
DIM SHARED yyy     AS SINGLE
DIM SHARED yyy1   AS SINGLE
DIM SHARED col
col = 9
DIM SHARED filenum
DIM SHARED comm$

'this is the command handling
100
CLS 2
COLOR 15
PRINT "end:exit  sin:enter a sinewave  sum:show sum of all sinewaves  sav:save bitmap"
PRINT "cls:clear screen  clm:clear memory"
PRINT "sub:enter sinewave to be subtracted from the sum. (This is the reference)"
LINE INPUT "dc:add dc   pek:trace highest points            Command=>"; comm$
IF comm$ = "cls" THEN CALL clearscreen
IF comm$ = "clm" THEN CALL clearmem
IF comm$ = "sin" THEN CALL newsin
IF comm$ = "sub" THEN CALL newsin
IF comm$ = "sum" THEN CALL summate
IF comm$ = "pek" THEN CALL showpeak
IF comm$ = "dc" THEN CALL dc
IF comm$ = "sav" THEN CALL savebmp
IF comm$ = "end" THEN SYSTEM
GOTO 100

SUB clearmem
ERASE peak
ERASE sum
END SUB

SUB clearscreen
CLS
COLOR 15
LINE (0, 0)-(639, 0)
LINE (0, 10)-(0, -10)
END SUB

SUB dc
CLS 2
COLOR 15
INPUT "Enter a dc value: "; dcv
col = col + 1
IF col > 14 THEN col = 9
COLOR col
FOR tic = 0 TO 639
    xxx = tic
    yyy = dcv
    sum(tic) = sum(tic) + yyy
    IF yyy > peak(tic) THEN peak(tic) = yyy
    LINE (xxx, yyy)-(xxx, yyy)
NEXT tic
COLOR 15
END SUB

SUB degrees
CLS 2
COLOR 15
INPUT "Enter delay in degrees: ", dly
dly = dly * 2! * pi / 360!
' converts delay degrees into radians
' ! is to designate data type 'single' to prevent overflow during calculations
END SUB

SUB degsec
120
CLS 2
COLOR 15
INPUT "Enter the frequency in degrees/second: ", frq
IF frq < 0 GOTO 120
frq = frq * 2! * pi / (640! * 360!)
' converts freq to rad/tic
END SUB

'------------------------this is the screen 12 bitmap generator---------------
SUB FourBIT (x1%, y1%, x2%, y2%, FileNAME$)
DIM FileCOLORS%(1 TO 48)
DIM Colors4%(15)

IF INSTR(FileNAME$, ".BMP") = 0 THEN
  FileNAME$ = RTRIM$(LEFT$(FileNAME$, 8)) + ".BMP"
END IF

FOR x = x1% TO x2%
  FOR y = y1% TO y2%
    Colors4%(POINT(x, y)) = 1
  NEXT y
NEXT x
FOR n = 0 TO 15
  IF Colors4%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1
NEXT n

FileTYPE$ = "BM"
Reserved1% = 0
Reserved2% = 0
OffsetBITS& = 118
InfoHEADER& = 40
PictureWIDTH& = x2% - x1% + 1
PictureDEPTH& = y2% - y1% + 1
NumPLANES% = 1
BPP% = 4
Compression& = 0
WidthPELS& = 3780
DepthPELS& = 3780
NumCOLORS& = 16

IF PictureWIDTH& MOD 8 <> 0 THEN
  ZeroPAD$ = SPACE$((8 - PictureWIDTH& MOD 8) \ 2)
END IF

ImageSIZE& = (((ImageWIDTH& + LEN(ZeroPAD$)) * ImageDEPTH&) + .1) / 2
FileSIZE& = ImageSIZE& + OffsetBITS&

Colr = 0
FOR n = 1 TO 48 STEP 3
  OUT &H3C7, Colr
  FileCOLORS%(n) = INP(&H3C9)
  FileCOLORS%(n + 1) = INP(&H3C9)
  FileCOLORS%(n + 2) = INP(&H3C9)
  Colr = Colr + 1
NEXT n

OPEN FileNAME$ FOR BINARY AS #1

PUT #1, , FileTYPE$
PUT #1, , FileSIZE&
PUT #1, , Reserved1% 'should be zero
PUT #1, , Reserved2% 'should be zero
PUT #1, , OffsetBITS&
PUT #1, , InfoHEADER&
PUT #1, , PictureWIDTH&
PUT #1, , PictureDEPTH&
PUT #1, , NumPLANES%
PUT #1, , BPP%
PUT #1, , Compression&
PUT #1, , ImageSIZE&
PUT #1, , WidthPELS&
PUT #1, , DepthPELS&
PUT #1, , NumCOLORS&
PUT #1, , SigCOLORS&

u$ = " "
FOR n% = 1 TO 46 STEP 3
  Colr$ = CHR$(FileCOLORS%(n% + 2) * 4)
  PUT #1, , Colr$
  Colr$ = CHR$(FileCOLORS%(n% + 1) * 4)
  PUT #1, , Colr$
  Colr$ = CHR$(FileCOLORS%(n%) * 4)
  PUT #1, , Colr$
  PUT #1, , u$ 'Unused byte
NEXT n%

FOR y = y2% TO y1% STEP -1
  FOR x = x1% TO x2% STEP 2
    HiX = POINT(x, y)
    LoX = POINT(x + 1, y)
    HiNIBBLE$ = HEX$(HiX)
    LoNIBBLE$ = HEX$(LoX)
    HexVAL$ = "&H" + HiNIBBLE$ + LoNIBBLE$
    a$ = CHR$(VAL(HexVAL$))
    PUT #1, , a$
  NEXT x
  PUT #1, , ZeroPAD$
NEXT y
CLOSE #1
END SUB

SUB hertz
140
CLS 2
COLOR 15
INPUT "Enter the frequency in hertz: ", frq
IF frq < 0 GOTO 140
frq = frq * 2! * pi / 640!
'converts freq to rad/tic
END SUB

SUB newsin
CLS 2
COLOR 15
INPUT "Enter sinewave amplitude (graph limits: -10 to 10): ", amp
CLS 2
COLOR 15
PRINT "Enter 'h' for frequency in hertz.   Enter 'r' for freq in Rad/s."
INPUT "Enter 'd' for Deg/sec. Or press enter for 0 frequency: "; freq$
frq = 0
IF freq$ = "h" THEN CALL hertz
IF freq$ = "r" THEN CALL radsec
IF freq$ = "d" THEN CALL degsec
PRINT "Enter 's' for phase delay in sec.    Enter 'r' for phase delay in radians."
INPUT "Enter 'd' for degrees.  Or press enter for no delay: "; del$
dly = 0
IF del$ = "s" THEN CALL seconds
IF del$ = "r" THEN CALL radians
IF del$ = "d" THEN CALL degrees
CLS 2
INPUT " Enter 'c' for cosine instead of sine: "; c$
IF c$ = "c" THEN dly = dly - (pi / 2!)
CLS 2
PRINT "Enter 'i' to clip the sinewave at 25% amplitude "
INPUT "Enter 'ip' to clip only the positive side at 25% amplitude: "; p$
CLS 2
PRINT "Enter 's' to shunt the sinewave at it's peaks"
INPUT "Enter 'sp' to shunt only positive peaks: "; s$
CLS 2
PRINT "Enter 'f' to rectify sinewave (full wave rectification) "
INPUT "Enter 'h' to rectify sinewave (half wave rectification): "; r$
CLS 2
col = col + 1
IF col > 14 THEN col = 9
COLOR col
'dly is in radians
'frq is in radians/tic
'angle is the angle in radians of the current tic
'angle1 is the angle in radians of the next tic
FOR tic = 0 TO 639
    xxx = tic
    xxx1 = tic + 1
    angle = (frq * tic) - dly
    angle1 = (frq * (tic + 1)) - dly
    yyy = amp * SIN(angle)
    yyy1 = amp * SIN(angle1)
    'This performs the clipping function positive side
    IF p$ = "ip" OR p$ = "i" THEN
        IF yyy > ABS(amp) * .25 THEN yyy = ABS(amp) * .25
        IF yyy1 > ABS(amp) * .25 THEN yyy1 = ABS(amp) * .25
    END IF
    'This performs the clipping function negative side
    IF p$ = "i" THEN
        IF yyy < ABS(amp) * -.25 THEN yyy = ABS(amp) * -.25
        IF yyy1 < ABS(amp) * -.25 THEN yyy1 = ABS(amp) * -.25
    END IF
    'This performs the upper shunting
     IF s$ = "sp" OR s$ = "s" THEN
          'If a or a1 is negative, this makes them positive
          DO WHILE angle < 0
               angle = angle + 2 * pi
          LOOP
          DO WHILE angle1 < 0
               angle1 = angle1 + 2 * pi
          LOOP
          'if angle is greater than 2pi, this DO loop removes multiples of 2pi from angle
          DO WHILE angle > 2 * pi
              angle = angle - 2 * pi
          LOOP
          'angle is now less than 2pi
          'To avoid rounding errors, angle will be formally rounded off.
          angle = angle * 100000
          angle = CLNG(angle)
          angle = angle / 100000
          'angle is still less than 2pi
          'Therefore, if pi/2 < angle < pi, then yyy is shunted
          IF angle > pi / 2 AND angle < pi THEN yyy = 0
          IF angle = pi / 2 OR angle = pi THEN yyy = 0
         'The same is done to angle1and yyy1
          DO WHILE angle1 > 2 * pi
              angle1 = angle1 - 2 * pi
          LOOP
          angle1 = angle1 * 100000
          angle1 = CLNG(angle1)
          angle1 = angle1 / 100000
          IF angle1 > pi / 2 AND angle1 < pi THEN yyy1 = 0
          IF angle1 = pi / 2 OR angle1 = pi THEN yyy1 = 0
     END IF
    'This performs the lower shunting
    ' The check for angle or angle1 < 0 was already done
    ' Removal of multiples of 2pi was done
    ' Rounding was done
     IF s$ = "s" THEN
         IF angle > 3 * pi / 2 THEN yyy = 0
         IF angle = 3 * pi / 2 OR angle = 2 * pi THEN yyy = 0
         IF angle1 > 3 * pi / 2 THEN yyy1 = 0
         IF angle1 = 3 * pi / 2 OR angle1 = 2 * pi THEN yyy1 = 0
     END IF
    'This performs half wave rectifying
    IF r$ = "h" THEN
          IF yyy < 0 THEN yyy = 0
          IF yyy1 < 0 THEN yyy1 = 0
    END IF
    'This performs full wave rectifying
    IF r$ = "f" THEN
          yyy = ABS(yyy)
          yyy1 = ABS(yyy1)
    END IF
    'This sums the sinewaves each time a new sinewave is added (for the sum command)
    'If it's a subtraction sinewave, the sinewave gets subtracted from the sum
    IF comm$ = "sub" THEN
         sum(tic) = sum(tic) - yyy
         GOTO 333
    END IF
    sum(tic) = sum(tic) + yyy
333
    'This keeps track of the most positive peaks (for the pek command)
    'If it's a subtraction sinewave, peaks are not modified
    IF comm$ = "sub" GOTO 222
    IF yyy > peak(tic) THEN peak(tic) = yyy
222
    LINE (xxx, yyy)-(xxx1, yyy1)
NEXT tic
COLOR 15
END SUB

SUB radians
CLS 2
COLOR 15
INPUT "Enter delay in radians: "; dly
END SUB

SUB radsec
160
CLS 2
COLOR 15
INPUT "Enter the frequency in rad/sec: ", frq
IF frq < 0 GOTO 160
frq = frq / 640!
'converts frq to rad/tic
END SUB

SUB savebmp
CLS 2
REM this generates the file name.
filenum = filenum + 1
filenm$ = STR$(filenum)
bitmapname$ = "SINE" + LTRIM$(filenm$)
PRINT bitmapname$
PRINT "Please wait while bitmap "; bitmapname$; " is being generated in the current folder."
PRINT "It may take a few minutes."
REM This clears VIEW and WINDOW commands prior to .bmp generation.
VIEW
WINDOW
REM This calls the bitmap generation SUB.
FourBIT 0, 0, 639, 479, bitmapname$
REM This restores the VIEW and WINDOW.
VIEW (0, 0)-(639, 400)
WINDOW (0, 10.1)-(639, -10.1)
VIEW PRINT 26 TO 30
END SUB

SUB seconds
CLS 2
COLOR 15
INPUT "Enter delay in seconds: "; dly
dly = dly * frq * 640!
'converts delay into rads
END SUB

SUB showpeak
COLOR 15
FOR tic = 0 TO 639
    xxx = tic
    xxx1 = tic + 1
    yyy = peak(tic)
    yyy1 = peak(tic + 1)
    LINE (xxx, yyy)-(xxx1, yyy1)
NEXT tic
END SUB

SUB summate
COLOR 15
FOR tic = 0 TO 639
    xxx = tic
    xxx1 = tic + 1
    yyy = sum(tic)
    yyy1 = sum(tic + 1)
    LINE (xxx, yyy)-(xxx1, yyy1)
NEXT tic
END SUB