Old Demo from Amstrad CPC 6128 Disk's

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Old Demo from Amstrad CPC 6128 Disk's

Post by jepalza »

For Amstrad CPC users nostalgic, like me...

Image

Code: Select all

Dim PI As Single = 3.14156
Dim i As Integer = 1
Dim T(3) As Integer

Dim s As single

Dim F As Integer = 1
Dim g As Integer

Dim A As Integer
Dim B As Integer
Dim C As integer

SCREEN 12

T(1) = 63 * 65536 + 0 * 256 + 0
T(2) = 0 * 65536 + 50 * 256 + 50
T(3) = 0 * 65536 + 0 * 256 + 50
PALETTE 1, T(1)
PALETTE 2, T(2)
PALETTE 3, T(3)

FOR s = 0 TO 4 * PI STEP PI / 60
 PSET (320 + (320 * SIN(s / 2)), 200 + (198 * COS(s)))
LINE -(320 + (200 * COS(s / 2)), 200 + (198 * SIN(s))), i
i = i + 1: IF i = 4 THEN i = 1
NEXT

While InKey$<>Chr$(27)
 If F = 1 THEN A = 1: B = 2: C = 3
 If F = 2 THEN A = 3: B = 1: C = 2
 If F = 3 THEN A = 2: B = 3: C = 1
 Palette 1, T(A)
 Palette 2, T(B)
 Palette 3, T(C)
 F = F + 1: IF F = 4 THEN F = 1
 Sleep 200
Wend
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by D.J.Peters »

yes retro feelings :-)

here are CPC on green monitor :lol:

Joshy

Code: Select all

dim as long iWidth,iHeight,iPitch
screeninfo iWidth,iHeight ' get screen size
iWidth *=0.75 ' make it a bit smaller
iHeight*=0.75
screenres iWidth,iHeight,8,2 ' setup two pages
screenset 1,0 ' one work page and one visible page

palette 0,0,48,0 ' darg green as background color
for i as long=1 to 255
  ' from darg green to bright green
  palette i,0,48+i/1.5,0
next  
' get current dimension and the pitch of one line
screeninfo iWidth,iHeight,,,iPitch

dim as single x(1),y(1),sx(1),sy(1)
for i as integer = 0 to 1
  x(i)=rnd*iWidth ' random x,y position of he line
  y(i)=rnd*iHeight
  sx(i)=3+rnd*5 ' random x,y speed of the line
  sy(i)=3+rnd*3
next  

while inkey()=""
  ' fade out all pixels by 1 to dark green
  dim as ubyte ptr row=screenptr()
  for y as integer=1 to iHeight
    dim as ubyte ptr pixel=row
    for x as integer=1 to iWidth
      if *pixel>0 then *pixel-=1
      pixel+=1 ' next pixel
    next
    row+=iPitch ' next row
  next
  ' draw the line in bright green
  line (x(0),y(0))-(x(1),y(1)),255
  ' animate the line 
  for i as integer=0 to 1
    ' x,y position + x,y speed if x or y goes out the screen reverse the speed direction (*-1)
    x(i)+=sx(i): if x(i)<0 orelse x(i)>=iWidth  then sx(i)*=-1:x(i)+=sx(i)
    y(i)+=sy(i): if y(i)<0 orelse y(i)>=iHeight then sy(i)*=-1:y(i)+=sy(i)
  next
  flip ' make the work page visible
  sleep 10
wend
jdebord
Posts: 547
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by jdebord »

There is a project named "Crocodile Basic" on the PANORAMIC Basic forum to revive the CPC BASIC, using FB as the compiler.

https://panoramic.1fr1.net/f38-crocodile-basic

It's all in french, though.
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by jepalza »

jdebord wrote: May 12, 2022 7:10 There is a project named "Crocodile Basic" on the PANORAMIC Basic forum to revive the CPC BASIC, using FB as the compiler.

https://panoramic.1fr1.net/f38-crocodile-basic

It's all in french, though.
How work it? With DLL?
I has one program (my only commercial game for CPC "abracadabra" from "proein softline" 1987) that i want to convert to Fb. :D

( https://www.cpc-power.com/index.php?page=detail&num=716 )
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by dodicat »

Far memory.
Click run to start.

Code: Select all


Type Point 
      As Single x,y,z
      As Ulong col
      As Single dx,dy
      As Single kx,ky
End Type
#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)

Function spline(p() As Point,t As Single) As Point
      #macro set(n)
      0.5 *(     (2 * P(2).n) +_
      (-1*P(1).n + P(3).n) * t +_
      (2*P(1).n - 5*P(2).n + 4*P(3).n - P(4).n) * t*t +_
      (-1*P(1).n + 3*P(2).n- 3*P(3).n + P(4).n) * t*t*t)
      #endmacro
      Return Type<Point>(set(x),set(y),set(z))
End Function

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

Sub GetCatmull(v() As Point,outarray() As Point,colour As Ulong,arraysize As Long=1000)
      Dim As Point p(1 To 4)
      Redim outarray(0)
      Dim As Single stepsize=(Ubound(v)-1)/(arraysize)
      If stepsize>1 Then stepsize=1
      For n As Long=2 To Ubound(v)-2
            p(1)=v(n-1):p(2)=v(n):p(3)=v(n+1):p(4)=v(n+2)
            For t As Single=0 To 1 Step stepsize
                  Redim Preserve outarray(1 To Ubound(outarray)+1)
                  outarray(Ubound(outarray))=spline(p(),t)
                  outarray(Ubound(outarray)).col=colour+Rnd*1000-Rnd*1000
            Next t
      Next n
End Sub  

Sub DrawCurve(a() As Point,ydisp As Long=0)
      Pset(a(Lbound(a)).x,a(Lbound(a)).y+ydisp),a(Lbound(a)).col
      For z As Long=Lbound(a)+1 To Ubound(a)
            Line-(a(z).x,a(z).y+ydisp),a(z).col
      Next z
End Sub

Function lngth(a() As Point) As Long
      Dim As Long acc
      For n As Long=Lbound(a) To Ubound(a)-1
            acc+=Abs(a(n).x-a(n+1).x) + Abs(a(n).y-a(n+1).y)
      Next n
      Return acc
End Function

Sub _line(x1 As Integer,y1 As Integer,x2 As Integer,y2 As Integer,l As Integer,col As Ulong,Byref xp As Integer=0,Byref yp As Integer=0)
      Dim As Integer diffx=x2-x1,diffy=y2-y1,ln=Sqr(diffx*diffx+diffy*diffy)
      If ln=0 Then ln=1e-6
      Dim As Single nx=diffx/ln,ny=diffy/ln 
      xp=x1+l*nx:yp=y1+l*ny
      Line(x1,y1)-(xp,yp),col
End Sub
Sub Bmouse(mx As Integer,my As Integer,sz As Integer)
      Dim As Integer xp,yp
      Dim As Ulong c=Rgb(255,255,250)
      _line(mx,my,mx+sz,my+.8*sz,sz,c,xp,yp)
      _line(xp,yp,mx+sz/2,yp+.03*sz,.4*sz,c,xp,yp)
      Var tx=xp,ty=yp
      _line(mx,my,mx,my+1.2*sz,sz,c,xp,yp)
      _line(xp,yp,mx+sz/2,yp-sz/2,.4*sz,c,xp,yp)
      _line(xp,yp,mx+sz/2,yp+sz/2,sz,c,xp,yp)
      _line(xp,yp,xp+sz/2,yp-.4*sz,.2*sz,c,xp,yp)
      _line(xp,yp,tx,ty,.95*sz,c,xp,yp)
      Paint(mx+.1*sz,my+.2*sz),c,c
End Sub

Randomize 1
Screen 20,32,,64

Dim As Point v(1 To 10)
Redim As Point C()
For n As Long=1 To Ubound(v)-2
      v(n)=Type(Rnd*800,500+Rnd*100,Rnd*200)
      v(n).kx=.01:v(n).ky=.01
Next n
v(Ubound(v)-1)=Type(400,300,0)
v(Ubound(v))=Type(400,200,0)
Getcatmull(v(),C(),Rgb(0,100,255),900)

Dim As Long L= lngth(C())/2
Dim As Single kx=2,ky=-2
Dim As Single dd=.1
Dim As Long fps',dist
Dim As Single dist

Dim As Any Ptr i=Imagecreate(1024,768)
Line i,(0,0)-(1024,20),Rgb(168,168,168),bf
Draw String i,(30,5),"File",Rgb(0,0,0)
Draw String i,(30+70,5),"Edit",Rgb(0,0,0)
Draw String i,(30+140,5),"View",Rgb(0,0,0)
Draw String i,(30+210,5),"Search",Rgb(0,0,0)
Draw String i,(30+290,5),"Run",Rgb(0,0,0)
Draw String i,(30+350,5),"Debug",Rgb(0,0,0)
Draw String i,(30+430,5),"Calls",Rgb(0,0,0)
Draw String i,(30+500,5),"Options",Rgb(0,0,0)
Draw String i,(950,5),"Help",Rgb(0,0,0)
Line i,(0,20)-(1024,768),Rgb(0,0,168),bf
Line i,(10,25)-(1015,760),Rgb(255,255,255),b
Line i,(0,745)-(1025,768),Rgb(0,168,168),bf
Line i,(1015,35)-(1015,710-170),Rgb(0,0,168)
Draw String i,(20,750)," <Shift+F1=Help>    <F6=Window>    (F2=Subs>    <F5=Run>    <F8=Step>     ",Rgb(0,0,0)
For n As Long = 35 To 700-170 Step 16
      Draw String i,(1010,n),Chr(176),Rgb(168,168,168)
Next
Line i,(1010,33)-(1018,53),Rgb(168,168,168),bf
Draw String i,(1010,33),Chr( 24 ),Rgb(0,0,0)
Line i,(1010,700-170)-(1018,720-170),Rgb(168,168,168),bf'bx
Draw String i,(1010,700-170),Chr( 25 ),Rgb(0,0,0)
Line i,(1010,53)-(1018,73),Rgb(0,0,0),bf
Var g=String(124, Chr(176) )'219
Draw String i,(20,550),g
Line i,(10,580)-(512-55,580),Rgb(168,168,168)
Line i,(512+55,580)-(1024-10,580),Rgb(168,168,168)
Draw String i,(512-40,573),"Immediate"
Line i,(10,550)-(30,565),Rgb(168,168,168),bf
Line i,(30,550)-(50,565),Rgb(0,0,0),bf
Draw String i,(15,550),Chr(27),Rgb(0,0,0)
Line i,(1000-10,550)-(1020-10,565),Rgb(168,168,168),bf
Draw String i,(1000,550),Chr(26),Rgb(0,0,0)
Draw String i,(750,750-6),"|",Rgb(0,0,0)
Draw String i,(750,750+2),"|",Rgb(0,0,0)
Draw String i,(800,750),Time,Rgb(0,0,0)
Dim As Long mx,my,btn
Do
      Screenlock
      Cls
      Getmouse mx,my,,btn
      
      If (mx>320 And mx<340 And my>4 And my<20) And btn Then 
            Line i,(0,0)-(1024,768),Rgb(255,0,255),bf
            Screenunlock
            Exit Do
      End If
      Put(0,0),i,Pset
      bmouse(330,15,18)
      Screenunlock
      Sleep 1
Loop
Dim As String key
Do
      Screenlock
      Line(0,0)-(1023,767),Rgba(0,0,0,2),bf
      v(Ubound(v)-1).x+=kx
      v(Ubound(v)-1).y+=ky
      
      
      If v(Ubound(v)-1).x<-50 Or v(Ubound(v)-1).x>1075  Then kx=-kx
      If v(Ubound(v)-1).y<-50  Or v(Ubound(v)-1).y>818 Then ky=-ky
      
      For n As Long=1 To Ubound(v)-1
            v(n).dx=(v(n+1).x-v(n).x)
            v(n).dy=(v(n+1).y-v(n).y)
            v(n).x+=v(n).kx*v(n).dx/(dd*(kx)):v(n).y+=v(n).ky*v(n).dy/(dd*(kx))
            If v(n).x<0  Or v(n).x>1024 Then v(n).kx=-v(n).kx
            If v(n).y<0 Or v(n).y>768 Then v(n).ky=-v(n).ky
      Next n
      
      Var clr=map(1000,5000,dist,50,200) 
      Getcatmull(v(),C(),Rgb(clr,100,255),900)
      dist=lngth(c())/(1+Rnd)
      If dist>l Then kx-=.001:ky-=.001
      If dist<l Then kx+=.001:ky+=.001
      
      drawcurve(C())
      Put(0,0),i,trans
      Screenunlock
      key=Inkey
      Sleep regulate(50,fps)
Loop Until key=Chr(27) Or key=Chr(255)+"k"
Imagedestroy i

 
Last edited by dodicat on May 13, 2022 13:08, edited 1 time in total.
jdebord
Posts: 547
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by jdebord »

jepalza wrote: May 12, 2022 19:20 How work it? With DLL?
You can download it here:

https://www.unilim.fr/pages_perso/jean. ... bcroco.htm

There is a DLL which implements several procedures in FB for most of the CPC commands (MODE, ORIGIN, PEN, PAPER, MOVE, PLOT ...)

You have also access to the Amstrad font and all its graphics characters.

But it is not an emulator. You will have to adapt the original Amstrad code.
jdebord
Posts: 547
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by jdebord »

For those who need only the Amstrad graphics, I have made a specific library :

amsgraph.zip

It's a static library, distributed as source code, with english documentation and 15 sample programs.

Image

Image
jepalza
Posts: 149
Joined: Feb 24, 2010 10:08
Location: Spain (Bilbao)

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by jepalza »

good :D

Looks similar to my CPC emu ;-)
viewtopic.php?p=272508&hilit=cpc+emulator#p272508
jdebord
Posts: 547
Joined: May 27, 2005 6:20
Location: Limoges, France
Contact:

Re: Old Demo from Amstrad CPC 6128 Disk's

Post by jdebord »

Thank you jepalza :)

I will check the emulator. It would be nice to convert some of these old BASIC games to FB, using the library.
Post Reply