' Program to render fancy looking text mode animations.
' Various effects are overlaid on top of each other
' while program scrolls it's own source code in the background.
'
' This program is free software: released under Creative Commons Zero (CC0) license
' by Svjatoslav Agejenko.
' Email: svjatoslav@svjatoslav.eu
' Homepage: http://www.svjatoslav.eu
'
' Changelog:
' 2003.10, Initial version
' 2024, Improved program readability

DECLARE SUB displayScreen ()
DECLARE SUB drawCircle ()
DECLARE SUB drawLines ()
DECLARE SUB fillBuffer ()
DECLARE SUB updateDisplay ()
DIM SHARED pi
DIM SHARED angle
DIM SHARED frameCounter
DIM SHARED buffer2(1 TO 50, 1 TO 80) AS STRING * 1
DIM SHARED buffer(1 TO 50, 1 TO 80) AS STRING * 1
DIM SHARED colors(1 TO 50, 1 TO 80) AS INTEGER

DIM SHARED verticalLinePosition, horizontalLinePosition
DIM SHARED verticalLineSpeed, horizontalLineSpeed

WIDTH 80, 50
VIEW PRINT 1 TO 50
pi = 3.14159
OPEN "mkcircle.bas" FOR INPUT AS #1

CLS

horizontalLinePosition = 20
horizontalLineSpeed = 1
verticalLinePosition = 20
verticalLineSpeed = 1

1
frameCounter = frameCounter + 1
SOUND 0, 1
displayScreen
fillBuffer
drawLines
drawCircle
updateDisplay
IF INKEY$ <> "" THEN GOTO 2
GOTO 1
2
CLOSE #1
SYSTEM

SUB updateDisplay
' This subroutine updates the display with the contents of the buffer
COLOR 7, 0
LOCATE 1, 1
FOR y = 1 TO 50
  FOR x = 1 TO 80
    COLOR colors(y, x)
    PRINT buffer(y, x);
    ' Swap the contents of buffer and buffer2
    buffer(y, x) = buffer2(y, x)
    colors(y, x) = 4
  NEXT x
NEXT y

END SUB

SUB fillBuffer
' This subroutine fills the buffer with a pattern
COLOR 4, 0
sizeMultiplier = SIN(frameCounter / 7) + 1.1

angle = angle + SIN(frameCounter / 30) / 10
radiusXPosition = 50 - SIN(angle + pi / 4) * 12 * 20 * sizeMultiplier
radiusYPosition = 50 - COS(angle + pi / 4) * 12 * 20 * sizeMultiplier

stepXPosition = SIN(angle) * 6 * sizeMultiplier
stepYPosition = COS(angle) * 6 * sizeMultiplier
radiusStepXPosition = SIN(angle + pi / 2) * 6 * sizeMultiplier
radiusStepYPosition = COS(angle + pi / 2) * 6 * sizeMultiplier

FOR y = 1 TO 50
  radiusXPosition = radiusXPosition + radiusStepXPosition
  radiusYPosition = radiusYPosition + radiusStepYPosition

4
IF radiusXPosition > 100 THEN radiusXPosition = radiusXPosition - 100: GOTO 4
IF radiusXPosition < 0 THEN radiusXPosition = radiusXPosition + 100: GOTO 4
IF radiusYPosition > 100 THEN radiusYPosition = radiusYPosition - 100: GOTO 4
IF radiusYPosition < 0 THEN radiusYPosition = radiusYPosition + 100: GOTO 4

currentXPosition = radiusXPosition
currentYPosition = radiusYPosition

FOR x = 1 TO 80
  characterCode = 0
  currentXPosition = currentXPosition + stepXPosition
  currentYPosition = currentYPosition + stepYPosition

3
IF currentXPosition > 100 THEN currentXPosition = currentXPosition - 100: GOTO 3
IF currentXPosition < 0 THEN currentXPosition = currentXPosition + 100: GOTO 3
IF currentYPosition > 100 THEN currentYPosition = currentYPosition - 100: GOTO 3
IF currentYPosition < 0 THEN currentYPosition = currentYPosition + 100: GOTO 3

IF currentXPosition < 12 OR currentYPosition < 12 THEN buffer(y, x) = "*": colors(y, x) = 9
NEXT x
NEXT y
END SUB

SUB drawCircle
' This subroutine draws a circle on the screen
circleSize = (SIN(frameCounter / 10) + 1.01) * 30
circleYPosition = SIN(frameCounter / 12) * 30 + 40
circleXPosition = COS(frameCounter / 17) * 15 + 25

FOR y = 1 TO 50
  xPositionOffset = SIN(y / 5 + frameCounter / 30) * circleSize / 10

IF (y >= circleYPosition - circleSize) AND (y <= circleYPosition + circleSize) THEN

halfHeight1 = SQR((y - (circleYPosition - circleSize)) * ((circleYPosition + circleSize) - y))
IF (y >= circleYPosition - circleSize / 2) AND (y <= circleYPosition + circleSize / 2) THEN halfHeight2 = SQR((y - (circleYPosition - circleSize / 2)) * ((circleYPosition + circleSize / 2) - y)) ELSE halfHeight2 = 0

startXPosition = circleXPosition - halfHeight1 + xPositionOffset
IF startXPosition < 1 THEN startXPosition = 1
endXPosition = circleXPosition - halfHeight2 + xPositionOffset
IF endXPosition > 80 THEN endXPosition = 80

FOR x = startXPosition TO endXPosition
  buffer(y, x) = CHR$(RND * 40 + 48)
  colors(y, x) = RND * 15
NEXT x

startXPosition = circleXPosition + halfHeight2 + xPositionOffset
IF startXPosition < 1 THEN startXPosition = 1
endXPosition = circleXPosition + halfHeight1 + xPositionOffset
IF endXPosition > 80 THEN endXPosition = 80

FOR x = startXPosition TO endXPosition
  buffer(y, x) = CHR$(RND * 200 + 32)
  colors(y, x) = RND * 15
NEXT x

END IF

NEXT y

END SUB

SUB drawLines
' This subroutine draws vertical and horizontal lines on the screen
verticalLinePosition = verticalLinePosition + verticalLineSpeed
IF verticalLinePosition > 49 THEN verticalLineSpeed = -1
IF verticalLinePosition < 2 THEN verticalLineSpeed = 1

horizontalLinePosition = horizontalLinePosition + horizontalLineSpeed
IF horizontalLinePosition > 79 THEN horizontalLineSpeed = -1
IF horizontalLinePosition < 2 THEN horizontalLineSpeed = 1

FOR x = 1 TO 80
  IF buffer(verticalLinePosition, x) = "*" THEN characterCode = 31 ELSE characterCode = 10
  buffer(verticalLinePosition, x) = "#"
  colors(verticalLinePosition, x) = characterCode
NEXT x

FOR y = 1 TO 50
  IF buffer(y, horizontalLinePosition) = "*" THEN characterCode = 31 ELSE characterCode = 10
  buffer(y, horizontalLinePosition) = "#"
  colors(y, horizontalLinePosition) = characterCode
NEXT y
END SUB

SUB displayScreen
' This subroutine displays the text from a file on the screen
IF EOF(1) <> 0 THEN
  CLOSE 1
  OPEN "mkcircle.bas" FOR INPUT AS #1
END IF

LINE INPUT #1, lineText$

FOR y = 1 TO 49
FOR x = 1 TO 80
  buffer2(y, x) = buffer2(y + 1, x)
NEXT x
NEXT y

FOR x = 1 TO 80
  buffer2(50, x) = " "
NEXT x

IF LEN(lineText$) > 80 THEN lineText$ = LEFT$(lineText$, 80)
FOR b = 1 TO LEN(lineText$)
  character$ = RIGHT$(LEFT$(lineText$, b), 1)
  buffer2(50, b) = character$
NEXT b

END SUB