Demo in PB?

Joubarbe · Post by **Joubarbe** » Wed Jan 21, 2026 11:18 am

Has anyone ever done a demo in PB?

For my next game, I'd really like to have an old-school demo that were used in the past (prehistoric times) to present the group that has cracked the game. And usually you had several games on the disk, so you had a menu to choose which one you want to play. Of course, it came with a trashy chiptune music!

I'm looking for source code if anyone has that. Or someone to commission

threedslider · Post by **threedslider** » Wed Jan 21, 2026 7:53 pm

Not me but someone has done in PB to pouet.net

See this link here : https://www.pouet.net/prod.php?which=66427

It is a bit old though

Enjoy !

Joubarbe · Post by **Joubarbe** » Wed Jan 21, 2026 8:18 pm

Uhuh, yeah... Thanks

Let's just say that Razor1911 had better ones on Atari ST 30 years ago

Mindphazer · Post by **Mindphazer** » Thu Jan 22, 2026 11:42 am

Just for fun.... (disable debugger)

Code: Select all

Enumeration
  #MainWindow
  #MainFont
  #BackFont
EndEnumeration

#Width = 1000
#Height = 600

InitSprite()
InitKeyboard()

OpenWindow(#MainWindow, 0, 0, #Width, #Height, "Old-School Demo", #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(#MainWindow), 0, 0, #Width, #Height, 0, 0, 0)

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
  LoadFont(#MainFont, "Showcard Gothic", 48, #PB_Font_Bold)
  LoadFont(#BackFont, "Segoe Print", 32)
CompilerElse
  LoadFont(#MainFont, "Phosphate", 54, #PB_Font_Bold)
  LoadFont(#BackFont, "SignPainter", 48)
CompilerEndIf

; -----------------------------
; Scroll text
; -----------------------------
Global ScrollText.s = "  *** PUREBASIC OLD SCHOOL DEMO ***  ";  GREETINGS To ALL RETRO CODERS !   "
Global ScrollText2.s = "Greeting to all retro coders, all Amiga & Atari Teams !!   This was indeed prehistoric times, but it was great times !!  "
Global ScrollX = #Width
Global ScrollSpeed = 3
Global Time.f = 0


Structure Star
  x.f
  y.f
  z.f
EndStructure

Global Dim Stars.star(199) ; 200 stars
For i = 0 To 199
  Stars(i)\x = Random(#Width-1)
  Stars(i)\y = Random(#Height-1)
  Stars(i)\z = 0.33 * Random(4)
Next

Procedure RGB_Cycle(phase.f)
  Protected r, g, b
  r = 128 + 127 * Sin(phase)
  g = 128 + 127 * Sin(phase + 2.1)
  b = 128 + 127 * Sin(phase + 4.2)
  ProcedureReturn RGB(r, g, b)
EndProcedure


Procedure DrawRasterBars_RedGradient(t.f)
  Protected barHeight = 14
  Protected centerY, y, dy
  Protected intensity, red
  Protected i.b
  DrawingMode(#PB_2DDrawing_Gradient)
  
  BackColor($4DCC11)
  GradientColor(0.5, $4E60CB)
  FrontColor($A57475)
  
  For i = 1 To 12
    y = 50 + i * barHeight + Sin(t + i * 0.4) * 25
    LinearGradient(0, y, 0, y + barHeight)
    Box(0, y, #Width, barHeight)
  Next
  

;   For i = 0 To 12
;     
;     y = 50 + i * barHeight + Sin(t + i * 0.4) * 25
;     BackColor($4DCCA9)
;     FrontColor($4E60CB)
;     LinearGradient(0, y, 0, y + barHeight / 2)
;     Box(0, y, #Width, barHeight / 2)
;     BackColor($4E60CB)
;     FrontColor($A57475)
;     LinearGradient(0, y + barHeight / 2, 0, y + barHeight)
;     Box(0, y + barHeight / 2, #Width, barHeight)
;     
;   Next
  DrawingMode(#PB_2DDrawing_Default)
EndProcedure

Procedure PlasmaColor(x, y, t.f)
  Protected v.f
  v = Sin((x + Sin(y*0.05 + t*0.5)*20) * 0.02 + t) + Sin((y + Sin(x*0.05 + t*0.3)*20) * 0.02 + t*1.3)
  v + Sin((x + y) * 0.02 + t * 0.7)
  v = (v + 3) / 6 * 255
  ProcedureReturn RGB(v, 128 + v / 2, 255 - v)
EndProcedure

Repeat
  Repeat
  Until WindowEvent() = 0
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    End
  EndIf

  FlipBuffers()
  ClearScreen(0)

  StartDrawing(ScreenOutput())

  cx0 = #Width / 2
  cy0 = #Height / 2

  For y = 0 To #Height Step 4
    For x = 0 To #Width Step 4
      dx.f = x - cx0
      dy.f = y - cy0
      dist.f = Sqr(dx*dx + dy*dy)
      angle.f = ATan2(dy, dx)

    ; effet twist
      angle + Sin(Time + dist * 0.02) * 0.5

      px = cx0 + Cos(angle) * dist
      py = cy0 + Sin(angle) * dist

      Box(x, y, 4, 4, PlasmaColor(px, py, Time))
    Next
  Next

  DrawRasterBars_RedGradient(Time)

  For i = 0 To 199
    Stars(i)\y - 1 * Stars(i)\z
    If Stars(i)\y < 0
      Stars(i)\y = #Height - 1
    EndIf
    ;col = RGB_Cycle(Time*3 + Stars(i)\phase)
    
    Circle(Stars(i)\x, Stars(i)\y, 1, #White)
    If Stars(i)\y + 11 < #Height And Stars(i)\z > 0
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      For j.b = 2 To 10
        ;Plot(Stars(i)\x, Stars(i)\y + j, RGB(255 -(j*9), 255 -(j*9), 255 - (j*9)))
        Plot(Stars(i)\x, Stars(i)\y + j, RGBA(255, 255, 255, 150 - (J*15)))
      Next j
      DrawingMode(#PB_2DDrawing_Default)
    EndIf
  Next


  DrawingFont(FontID(#MainFont))
  DrawingMode(#PB_2DDrawing_Transparent)
  cx = ScrollX
  L = Len(ScrollText)
  For i = 1 To L
    char.s = Mid(ScrollText, i, 1)
    charWidth = TextWidth(char)
    If cx + charWidth > 0 And cx < #Width
      cy = 260 + Sin((cx + Time * 10) * 0.02) * 30
      col = RGB_Cycle(Time + i * 0.25)
      DrawText(cx + 1, cy + 1, char, $333333)
      DrawText(cx, cy, char, col)
    EndIf
    cx + charWidth
  Next

  DrawingFont(FontID(#BackFont))
  cx = ScrollX
  L = Len(ScrollText2)
  For i = 1 To L
    char.s = Mid(ScrollText2, i, 1)
    charWidth = TextWidth(char)
    If cx + charWidth > 0 And cx < #Width
      DrawText(cx + 1, #Height - 99, char, $333333)
      DrawText(cx, #Height - 100, char, $E0E3F6)
    EndIf
    cx + charWidth
  Next

  ScrollX - ScrollSpeed
  If ScrollX < -TextWidth(ScrollText2)
    ScrollX = #Width
  EndIf

  Time + 0.05

  StopDrawing()

ForEver

Joubarbe · Post by **Joubarbe** » Thu Jan 22, 2026 12:53 pm

Haha, thanks, beautiful!

NicTheQuick · Post by **NicTheQuick** » Thu Jan 22, 2026 1:22 pm

I really thought the user xperience2003 in the German board had done such stuff. I was able to find him at pouet here: https://www.pouet.net/user.php?who=10329
But his only demo is only available as an executable, so I am not sure if this was written in Purebasic.

miso · Post by **miso** » Sat Jan 24, 2026 1:01 am

Also just for fun. Do not expect much. (works better with the new 6.40 alpha strings, but not required.)

Code: Select all

EnableExplicit

Global Dim OB(7)
ob(1)=RGB(0,16,48)
ob(2)=RGB(0,32,96)
ob(3)=RGB(0,64,128)
ob(4)=RGB(0,96,176)
ob(5)=RGB(32,128,208)
ob(6)=RGB(96,176,224)
ob(7)=RGB(176,224,255)

Global Dim OCN(11)
OCN(0)=RGBA(0,24,51,255)
OCN(1)=RGBA(0,51,102,255)
OCN(2)=RGBA(0,76,153,255)
OCN(3)=RGBA(0,102,204,255)
OCN(4)=RGBA(51,153,255,255)
OCN(5)=RGBA(102,204,255,255)
OCN(6)=OCN(5)
OCN(7)=OCN(4)
OCN(8)=OCN(3)
OCN(9)=OCN(2)
OCN(10)=OCN(1)
OCN(11)=OCN(0)


Procedure BuildSin256LUT()
  Global Dim sin256LUT.f(255)
  Protected i.i
  For i = 0 To 255
    sin256LUT(i)=Sin(Radian(i/255*359))
  Next i
EndProcedure

Procedure.f Sin256(d.a)
  ProcedureReturn(sin256LUT(d))
EndProcedure

Procedure.i createrasterbar_1()
  Protected id.i,i.i
  id = CreateSprite(#PB_Any,1,14,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(id))
  For i=0 To 6
    LineXY(0,i,OutputWidth(),i,ob(i+1))
  Next i
  For i=6 To 0 Step -1
    LineXY(0,13-i,OutputWidth(),i,ob(i+1))
  Next i
  
  StopDrawing()
  ZoomSprite(id,ScreenWidth(),14*4)
  ProcedureReturn id
EndProcedure

BuildSin256LUT()




;Text display module
DeclareModule petskii
EnableExplicit
;=======================================================================
;system font
;=======================================================================
  Declare LoadSyStemFont()
  Declare LoadRetroFont(Array colors(1))
  Declare text(x,y,text.s,color.i,intensity.i=255)
  Declare retrotext(x,y,text.s)
  Declare centertext(x,y,text.s,color.i,intensity.i=255)
  Declare FreeSyStemFont()
EndDeclareModule

;--MODULES, AUXILIARY
Module petskii
;======================================================
;System fonts  for displaying system messages on screen
;======================================================
  #USED_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
  Global Dim font(370):Global Dim fontimport.i(370)
  
  Procedure LoadSyStemFont()
    Protected x.i,i.i,j.i,sprline.a
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore sysfont
      For x= 1 To 370
        If fontimport(x)=1
          font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(font(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,RGBA(255,255,255,255)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(font(x),16,24)
        EndIf
      Next x
  EndProcedure
  
  Procedure BuildSin256LUT()
  Global Dim sin256LUT.f(255)
  Protected i.i
  For i = 0 To 255
    sin256LUT(i)=Sin(Radian(i/255*359))
  Next i
EndProcedure

  
  Procedure LoadRetroFont(Array colors(1))
    Protected x.i,i.i,j.i,sprline.a
    BuildSin256LUT()
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore sysfont
      For x= 1 To 370
        If fontimport(x)=1
          font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(font(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,colors(j)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(font(x),64,92)
        EndIf
      Next x
  EndProcedure
  
  
Procedure.f Sin256(d.a)
  ProcedureReturn(sin256LUT(d))
EndProcedure

  Procedure text(x,y,text.s,color.i,intensity.i=255) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    For i = 1 To textlength.i
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
      If IsSprite(font(character))
        DisplayTransparentSprite(font(character),(x+((i-1) * 16)),(y),intensity,color.i)
      EndIf
    Next i
  EndProcedure
  
  Procedure Retrotext(x.i,y.i,text.s) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    Protected sinvar.a, startpos.i
    Static offset.a
    offset+3
    If x<0 : startpos = Int(Abs(x))%64: EndIf
    For i = 1 To textlength.i
      
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
      If IsSprite(font(character))
        If x+(i-1)*64<ScreenWidth() And x+((i-1)*64)>-64
          DisplayTransparentSprite(font(character),(x+((i-1) * 64)),y+sin256(sinvar+offset)*20)
        ElseIf x+(i-1)*64>ScreenWidth()
          i=textlength
        EndIf
      EndIf
      sinvar+16
    Next i
  EndProcedure

  
  Procedure centertext(x,y,text.s,color.i,intensity=255)
    Protected textlength.i
    textlength.i = Len(text.s)
    x=x-(textlength*8) : y=y-8
    text(x,y,text.s,color,intensity)
  EndProcedure
  
 
  Procedure FreeSyStemFont()
    Protected i.i
    For i = 1 To Len(#USED_CHARACTERS)
      If IsSprite(font(i)) : FreeSprite(font(i)) : EndIf
    Next i
  EndProcedure
 DataSection
    sysfont:
    Data.q $3838383838380000,$EEEE000000003800,$00000000000000EE,$FFEEFFEEEEEE0000,$383800000000EEEE,$0000387EE07C0EFC,$1C3870EECECE0000,$7C7C00000000E6EE,$0000FCEEEE3C7CEE
    Data.q $00003870E0E00000,$7070000000000000,$000070381C1C1C38,$707070381C1C0000,$0000000000001C38,$000000EE7CFF7CEE,$38FE383800000000,$0000000000000038,$001C383800000000
    Data.q $00FE000000000000,$0000000000000000,$0000383800000000,$3870E0C000000000,$7C7C000000000E1C,$00007CEEEEFEFEEE,$38383C3838380000,$7C7C00000000FE38,$0000FE0E1C70E0EE
    Data.q $E078E0EE7C7C0000,$E0E0000000007CEE,$0000E0E0FEEEF8F0,$E0E07E0EFEFE0000,$7C7C000000007CEE,$00007CEEEE7E0EEE,$383870EEFEFE0000,$7C7C000000003838,$00007CEEEE7CEEEE
    Data.q $E0FCEEEE7C7C0000,$3838000000007CEE,$0000383800000038,$0000003838380000,$F0F00000001C3838,$0000F0381C0E1C38,$FE00FE0000000000,$1E1E000000000000,$00001E3870E07038
    Data.q $3870E0EE7C7C0000,$7C7C000000003800,$00007CCE0EFEFEEE,$EEFEEE7C38380000,$7E7E00000000EEEE,$00007EEEEE7EEEEE,$0E0E0EEE7C7C0000,$3E3E000000007CEE,$00003E7EEEEEEE7E
    Data.q $0E3E0E0EFEFE0000,$FEFE00000000FE0E,$00000E0E0E3E0E0E,$EEFE0EEE7C7C0000,$EEEE000000007CEE,$0000EEEEEEFEEEEE,$383838387C7C0000,$F8F8000000007C38,$00003C7E70707070
    Data.q $3E1E3E7EEEEE0000,$0E0E00000000EE7E,$0000FE0E0E0E0E0E,$CEFEFEFECECE0000,$EEEE00000000CECE,$0000EEEEFEFEFEFE,$EEEEEEEE7C7C0000,$7E7E000000007CEE,$00000E0E0E7EEEEE
    Data.q $EEEEEEEE7C7C0000,$7E7E00000000F07C,$0000EE7E3E7EEEEE,$E07C0EEE7C7C0000,$FEFE000000007CEE,$0000383838383838,$EEEEEEEEEEEE0000,$EEEE000000007CEE,$0000387CEEEEEEEE
    Data.q $FEFECECECECE0000,$EEEE00000000CEFE,$0000EEEE7C387CEE,$387CEEEEEEEE0000,$FEFE000000003838,$0000FE0E1C3870E0,$1C1C1C1C7C7C0000,$7C7C000000007C1C,$00007C7070707070
    Data.q $3838FE7C38380000,$0000000000003838,$0000FF0000000000,$FCE07C0000000000,$000000000000FCEE,$00007EEEEE7E0E0E,$0E0E7C0000000000,$0000000000007C0E,$0000FCEEEEFCE0E0
    Data.q $FEEE7C0000000000,$0000000000007C0E,$0000383838FC38F0,$EEEEFC0000000000,$0E0E0000007EE0FC,$0000EEEEEEEE7E0E,$38383C0038380000,$0000000000007C38,$003C707070700070
    Data.q $3E7E0E0E0E0E0000,$3C3C00000000EE7E,$00007C3838383838,$FEFEEE0000000000,$000000000000CEFE,$0000EEEEEEEE7E00,$EEEE7C0000000000,$0000000000007CEE,$000E0E7EEEEE7E00
    Data.q $EEEEFC0000000000,$0000000000E0E0FC,$00000E0E0EEE7E00,$7C0EFC0000000000,$0000000000007EE0,$0000F0383838FE38,$EEEEEE0000000000,$000000000000FCEE,$0000387CEEEEEE00
    Data.q $FEFECE0000000000,$000000000000FCFC,$0000EE7C387CEE00,$EEEEEE0000000000,$00000000003E70FC,$0000FE1C3870FE00,$381E3838F0F00000,$1E1E00000000F038,$00001E3838F03838
  EndDataSection
EndModule 


InitSprite():InitKeyboard():InitMouse()

ExamineDesktops()
OpenWindow(0, 0,0, 1092, 614, "Retro Scoller",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0, #PB_Screen_WaitSynchronization)

petskii::LoadretroFont(OCN())

Define rast.i, rastert.a=0, rasterb.a = 64, rasterc.a=128, scroller.i=50, txt.s
txt=PeekS(?s,?e-?s,#PB_UTF8)
rast=createrasterbar_1()
scroller = ScreenWidth()+10

Repeat
  While WindowEvent():Wend
  ClearScreen(0)
	ExamineKeyboard()
	ExamineMouse()
	MouseDeltaX()
	
  #P=3
  rastert+#P : rasterb+#P :rasterc+#P 
  scroller-4
If scroller<-42000 : scroller = ScreenWidth()+10: EndIf
  petskii::retrotext(scroller,ScreenHeight()/2-46,txt)
  
	DisplayTransparentSprite(rast,0,0+sin256LUT(rastert)*10*3)	
	DisplayTransparentSprite(rast,0,0+sin256LUT(rasterb)*10*3)	
	DisplayTransparentSprite(rast,0,0+sin256LUT(rasterc)*10*3)	
	
  DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rastert)*10*3)	
	DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rasterb)*10*3)	
	DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rasterc)*10*3)	
  
	FlipBuffers() : Delay(0)
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)
DataSection
  s:
  Data.a $48,$65,$6C,$6C,$6F,$21,$21,$21,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$47,$72,$65,$65,$74,$69,$6E,$67,$7A,$20,$74,$6F,$20,$46,$72,$65,$64,$2C,$20,$46,$72,$65
  Data.a $61,$6B,$2C,$20,$49,$64,$6C,$65,$2C,$20,$49,$6E,$66,$72,$61,$74,$65,$63,$2C,$20,$50,$66,$53,$68,$61,$64,$6F,$6B,$6F,$2C,$20,$4A,$61,$63,$64,$65,$6C,$61,$64,$2C,$20
  Data.a $4D,$69,$6E,$69,$6D,$79,$2C,$20,$49,$63,$65,$73,$6F,$66,$74,$2C,$20,$46,$61,$6E,$67,$62,$65,$61,$73,$74,$2C,$20,$48,$65,$58,$4F,$52,$2C,$20,$4A,$48,$50,$4A,$48,$50
  Data.a $2C,$20,$54,$68,$79,$70,$68,$6F,$6F,$6E,$2C,$20,$43,$61,$72,$6F,$6E,$74,$65,$33,$64,$2C,$20,$54,$68,$72,$65,$65,$64,$53,$6C,$69,$64,$65,$72,$2C,$20,$43,$61,$72,$6D
  Data.a $33,$44,$2C,$20,$52,$61,$6E,$64,$79,$20,$57,$61,$6C,$6B,$65,$72,$2C,$20,$6E,$65,$75,$72,$6F,$6E,$69,$63,$2C,$20,$20,$53,$70,$69,$6B,$65,$79,$2C,$20,$52,$62,$61,$72
  Data.a $74,$2C,$20,$44,$72,$67,$6F,$6C,$66,$2C,$20,$52,$69,$6E,$7A,$77,$69,$6E,$64,$2C,$20,$50,$65,$44,$65,$2C,$20,$53,$6B,$79,$77,$61,$6C,$6B,$2C,$20,$50,$68,$6F,$6C,$6C
  Data.a $79,$65,$72,$2C,$20,$53,$75,$73,$61,$6E,$2C,$20,$53,$65,$72,$67,$65,$79,$2C,$20,$4D,$69,$6E,$64,$70,$68,$61,$7A,$65,$72,$2C,$20,$6D,$6B,$2D,$73,$6F,$66,$74,$2C,$20
  Data.a $50,$69,$65,$72,$6F,$2C,$20,$41,$6E,$64,$72,$65,$2C,$20,$53,$4D,$61,$61,$67,$2C,$20,$4B,$77,$61,$69,$20,$43,$68,$61,$6E,$67,$20,$4B,$61,$6E,$65,$2C,$20,$4C,$6F,$72
  Data.a $64,$2C,$20,$53,$50,$48,$2C,$20,$44,$61,$72,$69,$75,$73,$20,$36,$37,$36,$2C,$20,$4A,$6F,$75,$62,$61,$72,$62,$65,$2C,$20,$41,$5A,$4A,$49,$4F,$2C,$20,$6D,$61,$72,$63
  Data.a $5F,$32,$35,$36,$2C,$20,$50,$6A,$61,$79,$2C,$20,$53,$6B,$69,$6E,$6B,$61,$69,$72,$65,$77,$61,$6C,$6B,$65,$72,$2C,$20,$4D,$69,$6A,$69,$6B,$61,$69,$2C,$20,$44,$69,$63
  Data.a $65,$6D,$61,$6E,$2C,$20,$43,$6F,$63,$6F,$32,$2C,$20,$4A,$61,$6B,$36,$34,$2C,$20,$53,$65,$72,$65,$67,$61,$5A,$2C,$20,$41,$78,$6F,$6C,$6F,$74,$6C,$2C,$20,$52,$41,$53
  Data.a $48,$41,$44,$2C,$20,$6D,$6F,$75,$6C,$64,$65,$72,$36,$31,$2C,$20,$63,$6F,$63,$6F,$32,$2C,$20,$55,$73,$65,$72,$5F,$52,$75,$73,$73,$69,$61,$6E,$2C,$20,$62,$65,$72,$72
  Data.a $79,$2C,$20,$4E,$69,$63,$54,$68,$65,$51,$75,$69,$63,$6B,$2C,$20,$53,$54,$41,$52,$47,$41,$54,$45,$2C,$20,$43,$68,$72,$69,$73,$52,$2C,$20,$44,$69,$73,$74,$6F,$72,$74
  Data.a $65,$64,$20,$50,$69,$78,$65,$6C,$2C,$20,$42,$61,$72,$72,$79,$47,$2C,$20,$50,$73,$79,$63,$68,$6F,$70,$68,$61,$6E,$74,$61,$2C,$20,$62,$65,$6E,$75,$62,$69,$2C,$20,$74
  Data.a $6A,$31,$30,$31,$30,$2C,$20,$20,$70,$66,$61,$62,$65,$72,$31,$31,$2C,$20,$6B,$65,$6E,$6D,$6F,$2C,$20,$61,$6E,$64,$20,$74,$6F,$20,$61,$6C,$6C,$20,$74,$68,$65,$20,$6F
  Data.a $74,$68,$65,$72,$20,$66,$65,$6C,$6C,$6F,$77,$20,$50,$42,$20,$75,$73,$65,$72,$73,$20,$63,$6F,$75,$6C,$64,$20,$6E,$6F,$74,$20,$66,$69,$74,$2E,$2E,$2E,$0D,$0A
  e:
EndDataSection
; IDE Options = PureBasic 6.30 beta 6 (Windows - x64)
; Folding = ---
; EnableXP
; DPIAware

Joubarbe · Post by **Joubarbe** » Sat Jan 24, 2026 9:48 am

Thank you miso; simple, but very cool!

miso · Post by **miso** » Sat Jan 24, 2026 9:51 am

Interesting effect. Looks good, but unfortunately, it comes from the sprite intensity bug I think. Did not expected this.
I'm on windows, this might behave differently on other OS-es.

Edit: I'm stupid

Code: Select all

EnableExplicit

Global Dim OB(7)
ob(1)=RGB(0,16,48)
ob(2)=RGB(0,32,96)
ob(3)=RGB(0,64,128)
ob(4)=RGB(0,96,176)
ob(5)=RGB(32,128,208)
ob(6)=RGB(96,176,224)
ob(7)=RGB(176,224,255)

Global Dim OCN(11)
OCN(0)=RGBA(0,24,51,255)
OCN(1)=RGBA(0,51,102,255)
OCN(2)=RGBA(0,76,153,255)
OCN(3)=RGBA(0,102,204,255)
OCN(4)=RGBA(51,153,255,255)
OCN(5)=RGBA(102,204,255,255)
OCN(6)=OCN(5)
OCN(7)=OCN(4)
OCN(8)=OCN(3)
OCN(9)=OCN(2)
OCN(10)=OCN(1)
OCN(11)=OCN(0)


Procedure BuildSin256LUT()
  Global Dim sin256LUT.f(255)
  Protected i.i
  For i = 0 To 255
    sin256LUT(i)=Sin(Radian(i/255*359))
  Next i
EndProcedure

Procedure.f Sin256(d.a)
  ProcedureReturn(sin256LUT(d))
EndProcedure

Procedure.i createrasterbar_1()
  Protected id.i,i.i
  id = CreateSprite(#PB_Any,1,14,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(id))
  For i=0 To 6
    LineXY(0,i,OutputWidth(),i,ob(i+1))
  Next i
  For i=6 To 0 Step -1
    LineXY(0,13-i,OutputWidth(),i,ob(i+1))
  Next i
  
  StopDrawing()
  ZoomSprite(id,ScreenWidth(),14*4)
  ProcedureReturn id
EndProcedure

Procedure.i createpixel(size)
  Protected id.i
  id = CreateSprite(#PB_Any,1,1,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(id))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight(),RGBA(255,255,255,255))
  StopDrawing()
  ZoomSprite(id,size,size)
  ProcedureReturn id
EndProcedure

BuildSin256LUT()




;Text display module
DeclareModule petskii
EnableExplicit
;=======================================================================
;system font
;=======================================================================
  Declare LoadSyStemFont()
  Declare LoadRetroFont(Array colors(1))
  Declare text(x,y,text.s,color.i,intensity.i=255)
  Declare retrotext(x,y,text.s)
  Declare centertext(x,y,text.s,color.i,intensity.i=255)
  Declare FreeSyStemFont()
EndDeclareModule

;--MODULES, AUXILIARY
Module petskii
;======================================================
;System fonts  for displaying system messages on screen
;======================================================
  #USED_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
  Global Dim font(370):Global Dim fontimport.i(370)
  
  Procedure LoadSyStemFont()
    Protected x.i,i.i,j.i,sprline.a
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore sysfont
      For x= 1 To 370
        If fontimport(x)=1
          font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(font(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,RGBA(255,255,255,255)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(font(x),16,24)
        EndIf
      Next x
  EndProcedure
  
  Procedure BuildSin256LUT()
  Global Dim sin256LUT.f(255)
  Protected i.i
  For i = 0 To 255
    sin256LUT(i)=Sin(Radian(i/255*359))
  Next i
EndProcedure

  
  Procedure LoadRetroFont(Array colors(1))
    Protected x.i,i.i,j.i,sprline.a
    BuildSin256LUT()
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore sysfont
      For x= 1 To 370
        If fontimport(x)=1
          font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(font(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,colors(j)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(font(x),64,92)
        EndIf
      Next x
  EndProcedure
  
  
Procedure.f Sin256(d.a)
  ProcedureReturn(sin256LUT(d))
EndProcedure

  Procedure text(x,y,text.s,color.i,intensity.i=255) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    For i = 1 To textlength.i
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
      If IsSprite(font(character))
        DisplayTransparentSprite(font(character),(x+((i-1) * 16)),(y),intensity,color.i)
      EndIf
    Next i
  EndProcedure
  
  Procedure Retrotext(x.i,y.i,text.s) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    Protected sinvar.a, startpos.i
    Static offset.a
    offset+3
    If x<0 : startpos = Int(Abs(x))%64: EndIf
    For i = 1 To textlength.i
      
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
      If IsSprite(font(character))
        If x+(i-1)*64<ScreenWidth() And x+((i-1)*64)>-64
          DisplayTransparentSprite(font(character),(x+((i-1) * 64)),y+sin256(sinvar+offset)*20)
        ElseIf x+(i-1)*64>ScreenWidth()
          i=textlength
        EndIf
      EndIf
      sinvar+16
    Next i
  EndProcedure

  
  Procedure centertext(x,y,text.s,color.i,intensity=255)
    Protected textlength.i
    textlength.i = Len(text.s)
    x=x-(textlength*8) : y=y-8
    text(x,y,text.s,color,intensity)
  EndProcedure
  
 
  Procedure FreeSyStemFont()
    Protected i.i
    For i = 1 To Len(#USED_CHARACTERS)
      If IsSprite(font(i)) : FreeSprite(font(i)) : EndIf
    Next i
  EndProcedure
 DataSection
    sysfont:
    Data.q $3838383838380000,$EEEE000000003800,$00000000000000EE,$FFEEFFEEEEEE0000,$383800000000EEEE,$0000387EE07C0EFC,$1C3870EECECE0000,$7C7C00000000E6EE,$0000FCEEEE3C7CEE
    Data.q $00003870E0E00000,$7070000000000000,$000070381C1C1C38,$707070381C1C0000,$0000000000001C38,$000000EE7CFF7CEE,$38FE383800000000,$0000000000000038,$001C383800000000
    Data.q $00FE000000000000,$0000000000000000,$0000383800000000,$3870E0C000000000,$7C7C000000000E1C,$00007CEEEEFEFEEE,$38383C3838380000,$7C7C00000000FE38,$0000FE0E1C70E0EE
    Data.q $E078E0EE7C7C0000,$E0E0000000007CEE,$0000E0E0FEEEF8F0,$E0E07E0EFEFE0000,$7C7C000000007CEE,$00007CEEEE7E0EEE,$383870EEFEFE0000,$7C7C000000003838,$00007CEEEE7CEEEE
    Data.q $E0FCEEEE7C7C0000,$3838000000007CEE,$0000383800000038,$0000003838380000,$F0F00000001C3838,$0000F0381C0E1C38,$FE00FE0000000000,$1E1E000000000000,$00001E3870E07038
    Data.q $3870E0EE7C7C0000,$7C7C000000003800,$00007CCE0EFEFEEE,$EEFEEE7C38380000,$7E7E00000000EEEE,$00007EEEEE7EEEEE,$0E0E0EEE7C7C0000,$3E3E000000007CEE,$00003E7EEEEEEE7E
    Data.q $0E3E0E0EFEFE0000,$FEFE00000000FE0E,$00000E0E0E3E0E0E,$EEFE0EEE7C7C0000,$EEEE000000007CEE,$0000EEEEEEFEEEEE,$383838387C7C0000,$F8F8000000007C38,$00003C7E70707070
    Data.q $3E1E3E7EEEEE0000,$0E0E00000000EE7E,$0000FE0E0E0E0E0E,$CEFEFEFECECE0000,$EEEE00000000CECE,$0000EEEEFEFEFEFE,$EEEEEEEE7C7C0000,$7E7E000000007CEE,$00000E0E0E7EEEEE
    Data.q $EEEEEEEE7C7C0000,$7E7E00000000F07C,$0000EE7E3E7EEEEE,$E07C0EEE7C7C0000,$FEFE000000007CEE,$0000383838383838,$EEEEEEEEEEEE0000,$EEEE000000007CEE,$0000387CEEEEEEEE
    Data.q $FEFECECECECE0000,$EEEE00000000CEFE,$0000EEEE7C387CEE,$387CEEEEEEEE0000,$FEFE000000003838,$0000FE0E1C3870E0,$1C1C1C1C7C7C0000,$7C7C000000007C1C,$00007C7070707070
    Data.q $3838FE7C38380000,$0000000000003838,$0000FF0000000000,$FCE07C0000000000,$000000000000FCEE,$00007EEEEE7E0E0E,$0E0E7C0000000000,$0000000000007C0E,$0000FCEEEEFCE0E0
    Data.q $FEEE7C0000000000,$0000000000007C0E,$0000383838FC38F0,$EEEEFC0000000000,$0E0E0000007EE0FC,$0000EEEEEEEE7E0E,$38383C0038380000,$0000000000007C38,$003C707070700070
    Data.q $3E7E0E0E0E0E0000,$3C3C00000000EE7E,$00007C3838383838,$FEFEEE0000000000,$000000000000CEFE,$0000EEEEEEEE7E00,$EEEE7C0000000000,$0000000000007CEE,$000E0E7EEEEE7E00
    Data.q $EEEEFC0000000000,$0000000000E0E0FC,$00000E0E0EEE7E00,$7C0EFC0000000000,$0000000000007EE0,$0000F0383838FE38,$EEEEEE0000000000,$000000000000FCEE,$0000387CEEEEEE00
    Data.q $FEFECE0000000000,$000000000000FCFC,$0000EE7C387CEE00,$EEEEEE0000000000,$00000000003E70FC,$0000FE1C3870FE00,$381E3838F0F00000,$1E1E00000000F038,$00001E3838F03838
  EndDataSection
EndModule 


InitSprite():InitKeyboard():InitMouse()

ExamineDesktops()
OpenWindow(0, 0,0, 1092,614, "Retro Scoller",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0, #PB_Screen_WaitSynchronization)

petskii::LoadretroFont(OCN())

Define rast.i, rastert.a=0, rasterb.a = 64, rasterc.a=128, scroller.i=50, txt.s, r.a,g.a,b.a,t.a,pix,x,y
txt=PeekS(?s,?e-?s,#PB_UTF8)
rast=createrasterbar_1()
pix =createpixel(5)
scroller = ScreenWidth()+10

Repeat
  While WindowEvent():Wend
  ;ClearScreen(RGBA(0,0,0,255))
	ExamineKeyboard()
	ExamineMouse()
	MouseDeltaX()
	t+1
	For x =0 To ScreenWidth()/5
	  For y =0 To ScreenHeight()/5
	    r=Int(Sin256(x*4+t))&255
	    g=Int(Sin256(y*4+t))&255
	    b=Int(Sin256(x+y+t))&255
	    DisplayTransparentSprite(pix,x*5,y*5,55,RGBA(r,g,b,255))
	  Next y
	Next x
	
	
	
  #P=3
  rastert+#P : rasterb+#P :rasterc+#P 
  scroller-4
If scroller<-42000 : scroller = ScreenWidth()+10: EndIf
  petskii::retrotext(scroller,ScreenHeight()/2-46,txt)
  
	DisplayTransparentSprite(rast,0,0+sin256LUT(rastert)*10*3)	
	DisplayTransparentSprite(rast,0,0+sin256LUT(rasterb)*10*3)	
	DisplayTransparentSprite(rast,0,0+sin256LUT(rasterc)*10*3)	
	
  DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rastert)*10*3)	
	DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rasterb)*10*3)	
	DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rasterc)*10*3)	
	
	
	DisplayTransparentSprite(pix,2000,4000,255,RGBA(255,255,255,255))
	FlipBuffers() : Delay(0)
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)
DataSection
  s:
  Data.a $48,$65,$6C,$6C,$6F,$21,$21,$21,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$47,$72,$65,$65,$74,$69,$6E,$67,$7A,$20,$74,$6F,$20,$46,$72,$65,$64,$2C,$20,$46,$72,$65
  Data.a $61,$6B,$2C,$20,$49,$64,$6C,$65,$2C,$20,$49,$6E,$66,$72,$61,$74,$65,$63,$2C,$20,$50,$66,$53,$68,$61,$64,$6F,$6B,$6F,$2C,$20,$4A,$61,$63,$64,$65,$6C,$61,$64,$2C,$20
  Data.a $4D,$69,$6E,$69,$6D,$79,$2C,$20,$49,$63,$65,$73,$6F,$66,$74,$2C,$20,$46,$61,$6E,$67,$62,$65,$61,$73,$74,$2C,$20,$48,$65,$58,$4F,$52,$2C,$20,$4A,$48,$50,$4A,$48,$50
  Data.a $2C,$20,$54,$68,$79,$70,$68,$6F,$6F,$6E,$2C,$20,$43,$61,$72,$6F,$6E,$74,$65,$33,$64,$2C,$20,$54,$68,$72,$65,$65,$64,$53,$6C,$69,$64,$65,$72,$2C,$20,$43,$61,$72,$6D
  Data.a $33,$44,$2C,$20,$52,$61,$6E,$64,$79,$20,$57,$61,$6C,$6B,$65,$72,$2C,$20,$6E,$65,$75,$72,$6F,$6E,$69,$63,$2C,$20,$20,$53,$70,$69,$6B,$65,$79,$2C,$20,$52,$62,$61,$72
  Data.a $74,$2C,$20,$44,$72,$67,$6F,$6C,$66,$2C,$20,$52,$69,$6E,$7A,$77,$69,$6E,$64,$2C,$20,$50,$65,$44,$65,$2C,$20,$53,$6B,$79,$77,$61,$6C,$6B,$2C,$20,$50,$68,$6F,$6C,$6C
  Data.a $79,$65,$72,$2C,$20,$53,$75,$73,$61,$6E,$2C,$20,$53,$65,$72,$67,$65,$79,$2C,$20,$4D,$69,$6E,$64,$70,$68,$61,$7A,$65,$72,$2C,$20,$6D,$6B,$2D,$73,$6F,$66,$74,$2C,$20
  Data.a $50,$69,$65,$72,$6F,$2C,$20,$41,$6E,$64,$72,$65,$2C,$20,$53,$4D,$61,$61,$67,$2C,$20,$4B,$77,$61,$69,$20,$43,$68,$61,$6E,$67,$20,$4B,$61,$6E,$65,$2C,$20,$4C,$6F,$72
  Data.a $64,$2C,$20,$53,$50,$48,$2C,$20,$44,$61,$72,$69,$75,$73,$20,$36,$37,$36,$2C,$20,$4A,$6F,$75,$62,$61,$72,$62,$65,$2C,$20,$41,$5A,$4A,$49,$4F,$2C,$20,$6D,$61,$72,$63
  Data.a $5F,$32,$35,$36,$2C,$20,$50,$6A,$61,$79,$2C,$20,$53,$6B,$69,$6E,$6B,$61,$69,$72,$65,$77,$61,$6C,$6B,$65,$72,$2C,$20,$4D,$69,$6A,$69,$6B,$61,$69,$2C,$20,$44,$69,$63
  Data.a $65,$6D,$61,$6E,$2C,$20,$43,$6F,$63,$6F,$32,$2C,$20,$4A,$61,$6B,$36,$34,$2C,$20,$53,$65,$72,$65,$67,$61,$5A,$2C,$20,$41,$78,$6F,$6C,$6F,$74,$6C,$2C,$20,$52,$41,$53
  Data.a $48,$41,$44,$2C,$20,$6D,$6F,$75,$6C,$64,$65,$72,$36,$31,$2C,$20,$63,$6F,$63,$6F,$32,$2C,$20,$55,$73,$65,$72,$5F,$52,$75,$73,$73,$69,$61,$6E,$2C,$20,$62,$65,$72,$72
  Data.a $79,$2C,$20,$4E,$69,$63,$54,$68,$65,$51,$75,$69,$63,$6B,$2C,$20,$53,$54,$41,$52,$47,$41,$54,$45,$2C,$20,$43,$68,$72,$69,$73,$52,$2C,$20,$44,$69,$73,$74,$6F,$72,$74
  Data.a $65,$64,$20,$50,$69,$78,$65,$6C,$2C,$20,$42,$61,$72,$72,$79,$47,$2C,$20,$50,$73,$79,$63,$68,$6F,$70,$68,$61,$6E,$74,$61,$2C,$20,$62,$65,$6E,$75,$62,$69,$2C,$20,$74
  Data.a $6A,$31,$30,$31,$30,$2C,$20,$20,$70,$66,$61,$62,$65,$72,$31,$31,$2C,$20,$6B,$65,$6E,$6D,$6F,$2C,$20,$61,$6E,$64,$20,$74,$6F,$20,$61,$6C,$6C,$20,$74,$68,$65,$20,$6F
  Data.a $74,$68,$65,$72,$20,$66,$65,$6C,$6C,$6F,$77,$20,$50,$42,$20,$75,$73,$65,$72,$73,$20,$63,$6F,$75,$6C,$64,$20,$6E,$6F,$74,$20,$66,$69,$74,$2E,$2E,$2E,$0D,$0A
  e:
EndDataSection

@Joubarbe : was fun to me too, your welcome

miso · Post by **miso** » Sat Jan 24, 2026 11:43 am

Code: Select all

EnableExplicit

Global Dim OB(7)
ob(1)=RGB(0,16,48)
ob(2)=RGB(0,32,96)
ob(3)=RGB(0,64,128)
ob(4)=RGB(0,96,176)
ob(5)=RGB(32,128,208)
ob(6)=RGB(96,176,224)
ob(7)=RGB(176,224,255)

Global Dim OCN(11)
OCN(0)=RGBA(0,24,51,255)
OCN(1)=RGBA(0,51,102,255)
OCN(2)=RGBA(0,76,153,255)
OCN(3)=RGBA(0,102,204,255)
OCN(4)=RGBA(51,153,255,255)
OCN(5)=RGBA(102,204,255,255)
OCN(6)=OCN(5)
OCN(7)=OCN(4)
OCN(8)=OCN(3)
OCN(9)=OCN(2)
OCN(10)=OCN(1)
OCN(11)=OCN(0)


Procedure BuildSin256LUT()
  Global Dim sin256LUT.f(255)
  Protected i.i
  For i = 0 To 255
    sin256LUT(i)=Sin(Radian(i/255*359))
  Next i
EndProcedure

Procedure.f Sin256(d.a)
  ProcedureReturn(sin256LUT(d))
EndProcedure

Procedure.i createrasterbar_1()
  Protected id.i,i.i
  id = CreateSprite(#PB_Any,1,14,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(id))
  For i=0 To 6
    LineXY(0,i,OutputWidth(),i,ob(i+1))
  Next i
  For i=6 To 0 Step -1
    LineXY(0,13-i,OutputWidth(),i,ob(i+1))
  Next i
  
  StopDrawing()
  ZoomSprite(id,ScreenWidth(),14*4)
  ProcedureReturn id
EndProcedure

Procedure.i createpixel(size)
  Protected id.i
  id = CreateSprite(#PB_Any,1,1,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(id))
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0,0,OutputWidth(),OutputHeight(),RGBA(255,255,255,255))
  StopDrawing()
  ZoomSprite(id,size,size)
  ProcedureReturn id
EndProcedure

BuildSin256LUT()




;Text display module
DeclareModule petskii
EnableExplicit
;=======================================================================
;system font
;=======================================================================
  Declare LoadSyStemFont()
  Declare LoadRetroFont(Array colors(1))
  Declare text(x,y,text.s,color.i,intensity.i=255)
  Declare retrotext(x,y,text.s)
  Declare centertext(x,y,text.s,color.i,intensity.i=255)
  Declare FreeSyStemFont()
EndDeclareModule

;--MODULES, AUXILIARY
Module petskii
;======================================================
;System fonts  for displaying system messages on screen
;======================================================
  #USED_CHARACTERS="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*()-_=+[{]};:',<.>/?"+Chr(34)
  Global Dim font(370):Global Dim fontimport.i(370)
  
  Procedure LoadSyStemFont()
    Protected x.i,i.i,j.i,sprline.a
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore sysfont
      For x= 1 To 370
        If fontimport(x)=1
          font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(font(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,RGBA(255,255,255,255)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(font(x),16,24)
        EndIf
      Next x
  EndProcedure
  
  Procedure BuildSin256LUT()
  Global Dim sin256LUT.f(255)
  Protected i.i
  For i = 0 To 255
    sin256LUT(i)=Sin(Radian(i/255*359))
  Next i
EndProcedure

  
  Procedure LoadRetroFont(Array colors(1))
    Protected x.i,i.i,j.i,sprline.a
    BuildSin256LUT()
    For i = 1 To Len(#USED_CHARACTERS):fontImport(Asc(Mid(#USED_CHARACTERS,i,1)))=1 : Next i 
    Restore sysfont
      For x= 1 To 370
        If fontimport(x)=1
          font(x)=CreateSprite(-1,8,12,#PB_Sprite_AlphaBlending)
          StartDrawing(SpriteOutput(font(x)))
          DrawingMode(#PB_2DDrawing_AllChannels)
          For j=0 To 11  
            Read.a sprline 
            For i=0 To 7
              If sprline&%1 :Plot(i,j,colors(j)): Else : Plot(i,j,RGBA(0,0,0,0)) : EndIf
              sprline>>1 
            Next i
          Next j
          StopDrawing()
          ZoomSprite(font(x),64,92)
        EndIf
      Next x
  EndProcedure
  
  
Procedure.f Sin256(d.a)
  ProcedureReturn(sin256LUT(d))
EndProcedure

  Procedure text(x,y,text.s,color.i,intensity.i=255) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    For i = 1 To textlength.i
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
      If IsSprite(font(character))
        DisplayTransparentSprite(font(character),(x+((i-1) * 16)),(y),intensity,color.i)
      EndIf
    Next i
  EndProcedure
  
  Procedure Retrotext(x.i,y.i,text.s) : Protected.i textlength,i,character
    textlength.i = Len(text.s)
    Protected sinvar.a, startpos.i
    Static offset.a
    offset+3
    If x<0 : startpos = Int(Abs(x))%64: EndIf
    For i = 1 To textlength.i
      
      character.i = Asc(Mid(text.s,i,1))
      If character.i>ArraySize(font()) : ProcedureReturn #Null : EndIf
      If IsSprite(font(character))
        If x+(i-1)*64<ScreenWidth() And x+((i-1)*64)>-64
          DisplayTransparentSprite(font(character),(x+((i-1) * 64)),y+sin256(sinvar+offset)*20)
        ElseIf x+(i-1)*64>ScreenWidth()
          i=textlength
        EndIf
      EndIf
      sinvar+16
    Next i
  EndProcedure

  
  Procedure centertext(x,y,text.s,color.i,intensity=255)
    Protected textlength.i
    textlength.i = Len(text.s)
    x=x-(textlength*8) : y=y-8
    text(x,y,text.s,color,intensity)
  EndProcedure
  
 
  Procedure FreeSyStemFont()
    Protected i.i
    For i = 1 To Len(#USED_CHARACTERS)
      If IsSprite(font(i)) : FreeSprite(font(i)) : EndIf
    Next i
  EndProcedure
 DataSection
    sysfont:
    Data.q $3838383838380000,$EEEE000000003800,$00000000000000EE,$FFEEFFEEEEEE0000,$383800000000EEEE,$0000387EE07C0EFC,$1C3870EECECE0000,$7C7C00000000E6EE,$0000FCEEEE3C7CEE
    Data.q $00003870E0E00000,$7070000000000000,$000070381C1C1C38,$707070381C1C0000,$0000000000001C38,$000000EE7CFF7CEE,$38FE383800000000,$0000000000000038,$001C383800000000
    Data.q $00FE000000000000,$0000000000000000,$0000383800000000,$3870E0C000000000,$7C7C000000000E1C,$00007CEEEEFEFEEE,$38383C3838380000,$7C7C00000000FE38,$0000FE0E1C70E0EE
    Data.q $E078E0EE7C7C0000,$E0E0000000007CEE,$0000E0E0FEEEF8F0,$E0E07E0EFEFE0000,$7C7C000000007CEE,$00007CEEEE7E0EEE,$383870EEFEFE0000,$7C7C000000003838,$00007CEEEE7CEEEE
    Data.q $E0FCEEEE7C7C0000,$3838000000007CEE,$0000383800000038,$0000003838380000,$F0F00000001C3838,$0000F0381C0E1C38,$FE00FE0000000000,$1E1E000000000000,$00001E3870E07038
    Data.q $3870E0EE7C7C0000,$7C7C000000003800,$00007CCE0EFEFEEE,$EEFEEE7C38380000,$7E7E00000000EEEE,$00007EEEEE7EEEEE,$0E0E0EEE7C7C0000,$3E3E000000007CEE,$00003E7EEEEEEE7E
    Data.q $0E3E0E0EFEFE0000,$FEFE00000000FE0E,$00000E0E0E3E0E0E,$EEFE0EEE7C7C0000,$EEEE000000007CEE,$0000EEEEEEFEEEEE,$383838387C7C0000,$F8F8000000007C38,$00003C7E70707070
    Data.q $3E1E3E7EEEEE0000,$0E0E00000000EE7E,$0000FE0E0E0E0E0E,$CEFEFEFECECE0000,$EEEE00000000CECE,$0000EEEEFEFEFEFE,$EEEEEEEE7C7C0000,$7E7E000000007CEE,$00000E0E0E7EEEEE
    Data.q $EEEEEEEE7C7C0000,$7E7E00000000F07C,$0000EE7E3E7EEEEE,$E07C0EEE7C7C0000,$FEFE000000007CEE,$0000383838383838,$EEEEEEEEEEEE0000,$EEEE000000007CEE,$0000387CEEEEEEEE
    Data.q $FEFECECECECE0000,$EEEE00000000CEFE,$0000EEEE7C387CEE,$387CEEEEEEEE0000,$FEFE000000003838,$0000FE0E1C3870E0,$1C1C1C1C7C7C0000,$7C7C000000007C1C,$00007C7070707070
    Data.q $3838FE7C38380000,$0000000000003838,$0000FF0000000000,$FCE07C0000000000,$000000000000FCEE,$00007EEEEE7E0E0E,$0E0E7C0000000000,$0000000000007C0E,$0000FCEEEEFCE0E0
    Data.q $FEEE7C0000000000,$0000000000007C0E,$0000383838FC38F0,$EEEEFC0000000000,$0E0E0000007EE0FC,$0000EEEEEEEE7E0E,$38383C0038380000,$0000000000007C38,$003C707070700070
    Data.q $3E7E0E0E0E0E0000,$3C3C00000000EE7E,$00007C3838383838,$FEFEEE0000000000,$000000000000CEFE,$0000EEEEEEEE7E00,$EEEE7C0000000000,$0000000000007CEE,$000E0E7EEEEE7E00
    Data.q $EEEEFC0000000000,$0000000000E0E0FC,$00000E0E0EEE7E00,$7C0EFC0000000000,$0000000000007EE0,$0000F0383838FE38,$EEEEEE0000000000,$000000000000FCEE,$0000387CEEEEEE00
    Data.q $FEFECE0000000000,$000000000000FCFC,$0000EE7C387CEE00,$EEEEEE0000000000,$00000000003E70FC,$0000FE1C3870FE00,$381E3838F0F00000,$1E1E00000000F038,$00001E3838F03838
  EndDataSection
EndModule 


InitSprite():InitKeyboard():InitMouse()

ExamineDesktops()
OpenWindow(0, 0,0, 1092,614, "Retro Scoller",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0), WindowHeight(0), 0, 0, 0, #PB_Screen_WaitSynchronization)

petskii::LoadretroFont(OCN())

Define rast.i, rastert.a=0, rasterb.a = 64, rasterc.a=128, scroller.i=50, txt.s, r.a,g.a,b.a,t.a,pix,x,y
txt=PeekS(?s,?e-?s,#PB_UTF8)
rast=createrasterbar_1()
pix =createpixel(20)
scroller = ScreenWidth()+10

Repeat
  While WindowEvent():Wend
  ;ClearScreen(RGBA(0,0,0,255))
	ExamineKeyboard()
	ExamineMouse()
	MouseDeltaX()
	t+3
	For x =0 To ScreenWidth()/20
	  For y =0 To ScreenHeight()/20
	    r=Int(Sin256(x*3+t)*255)
	    g=Int(Sin256(y*3+t)*255)
	    b=Int(Sin256(x+3+t)*255)
	    DisplayTransparentSprite(pix,x*20,y*20,255,RGBA(r,g,b,255))
	  Next y
	Next x
	
	
	
  #P=3
  rastert+#P : rasterb+#P :rasterc+#P 
  scroller-4
If scroller<-42000 : scroller = ScreenWidth()+10: EndIf
  petskii::retrotext(scroller,ScreenHeight()/2-46,txt)
  
	DisplayTransparentSprite(rast,0,0+sin256LUT(rastert)*10*3)	
	DisplayTransparentSprite(rast,0,0+sin256LUT(rasterb)*10*3)	
	DisplayTransparentSprite(rast,0,0+sin256LUT(rasterc)*10*3)	
	
  DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rastert)*10*3)	
	DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rasterb)*10*3)	
	DisplayTransparentSprite(rast,0,ScreenHeight()-56+sin256LUT(rasterc)*10*3)	
	
	
	;DisplayTransparentSprite(pix,2000,4000,255,RGBA(255,255,255,255))
	FlipBuffers() : Delay(0)
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)
DataSection
  s:
  Data.a $48,$65,$6C,$6C,$6F,$21,$21,$21,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$20,$47,$72,$65,$65,$74,$69,$6E,$67,$7A,$20,$74,$6F,$20,$46,$72,$65,$64,$2C,$20,$46,$72,$65
  Data.a $61,$6B,$2C,$20,$49,$64,$6C,$65,$2C,$20,$49,$6E,$66,$72,$61,$74,$65,$63,$2C,$20,$50,$66,$53,$68,$61,$64,$6F,$6B,$6F,$2C,$20,$4A,$61,$63,$64,$65,$6C,$61,$64,$2C,$20
  Data.a $4D,$69,$6E,$69,$6D,$79,$2C,$20,$49,$63,$65,$73,$6F,$66,$74,$2C,$20,$46,$61,$6E,$67,$62,$65,$61,$73,$74,$2C,$20,$48,$65,$58,$4F,$52,$2C,$20,$4A,$48,$50,$4A,$48,$50
  Data.a $2C,$20,$54,$68,$79,$70,$68,$6F,$6F,$6E,$2C,$20,$43,$61,$72,$6F,$6E,$74,$65,$33,$64,$2C,$20,$54,$68,$72,$65,$65,$64,$53,$6C,$69,$64,$65,$72,$2C,$20,$43,$61,$72,$6D
  Data.a $33,$44,$2C,$20,$52,$61,$6E,$64,$79,$20,$57,$61,$6C,$6B,$65,$72,$2C,$20,$6E,$65,$75,$72,$6F,$6E,$69,$63,$2C,$20,$20,$53,$70,$69,$6B,$65,$79,$2C,$20,$52,$62,$61,$72
  Data.a $74,$2C,$20,$44,$72,$67,$6F,$6C,$66,$2C,$20,$52,$69,$6E,$7A,$77,$69,$6E,$64,$2C,$20,$50,$65,$44,$65,$2C,$20,$53,$6B,$79,$77,$61,$6C,$6B,$2C,$20,$50,$68,$6F,$6C,$6C
  Data.a $79,$65,$72,$2C,$20,$53,$75,$73,$61,$6E,$2C,$20,$53,$65,$72,$67,$65,$79,$2C,$20,$4D,$69,$6E,$64,$70,$68,$61,$7A,$65,$72,$2C,$20,$6D,$6B,$2D,$73,$6F,$66,$74,$2C,$20
  Data.a $50,$69,$65,$72,$6F,$2C,$20,$41,$6E,$64,$72,$65,$2C,$20,$53,$4D,$61,$61,$67,$2C,$20,$4B,$77,$61,$69,$20,$43,$68,$61,$6E,$67,$20,$4B,$61,$6E,$65,$2C,$20,$4C,$6F,$72
  Data.a $64,$2C,$20,$53,$50,$48,$2C,$20,$44,$61,$72,$69,$75,$73,$20,$36,$37,$36,$2C,$20,$4A,$6F,$75,$62,$61,$72,$62,$65,$2C,$20,$41,$5A,$4A,$49,$4F,$2C,$20,$6D,$61,$72,$63
  Data.a $5F,$32,$35,$36,$2C,$20,$50,$6A,$61,$79,$2C,$20,$53,$6B,$69,$6E,$6B,$61,$69,$72,$65,$77,$61,$6C,$6B,$65,$72,$2C,$20,$4D,$69,$6A,$69,$6B,$61,$69,$2C,$20,$44,$69,$63
  Data.a $65,$6D,$61,$6E,$2C,$20,$43,$6F,$63,$6F,$32,$2C,$20,$4A,$61,$6B,$36,$34,$2C,$20,$53,$65,$72,$65,$67,$61,$5A,$2C,$20,$41,$78,$6F,$6C,$6F,$74,$6C,$2C,$20,$52,$41,$53
  Data.a $48,$41,$44,$2C,$20,$6D,$6F,$75,$6C,$64,$65,$72,$36,$31,$2C,$20,$63,$6F,$63,$6F,$32,$2C,$20,$55,$73,$65,$72,$5F,$52,$75,$73,$73,$69,$61,$6E,$2C,$20,$62,$65,$72,$72
  Data.a $79,$2C,$20,$4E,$69,$63,$54,$68,$65,$51,$75,$69,$63,$6B,$2C,$20,$53,$54,$41,$52,$47,$41,$54,$45,$2C,$20,$43,$68,$72,$69,$73,$52,$2C,$20,$44,$69,$73,$74,$6F,$72,$74
  Data.a $65,$64,$20,$50,$69,$78,$65,$6C,$2C,$20,$42,$61,$72,$72,$79,$47,$2C,$20,$50,$73,$79,$63,$68,$6F,$70,$68,$61,$6E,$74,$61,$2C,$20,$62,$65,$6E,$75,$62,$69,$2C,$20,$74
  Data.a $6A,$31,$30,$31,$30,$2C,$20,$20,$70,$66,$61,$62,$65,$72,$31,$31,$2C,$20,$6B,$65,$6E,$6D,$6F,$2C,$20,$61,$6E,$64,$20,$74,$6F,$20,$61,$6C,$6C,$20,$74,$68,$65,$20,$6F
  Data.a $74,$68,$65,$72,$20,$66,$65,$6C,$6C,$6F,$77,$20,$50,$42,$20,$75,$73,$65,$72,$73,$20,$63,$6F,$75,$6C,$64,$20,$6E,$6F,$74,$20,$66,$69,$74,$2E,$2E,$2E,$0D,$0A
  e:
EndDataSection

PureBasic Forums - English

Demo in PB?

Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?

Re: Demo in PB?