// DVDTRONIC videomaker - Apr 04 - by Sylvain Huet // Metal var file="The_Ketchup_Song";; var file="DancingQueen";; var file="Lorie - Week end";; var intro=250;; // nb frames de l'intro var nbdataperpage=45;; // nb de data par page (hors header : magic + opcode, et hors zéro final) // variables diverses var win;; var bmp;; var width=620;; var height=300;; proto paint 1;; proto makeavi 3;; var gifleft;; var gifright;; var gifplay;; var gifpause;; var gifsave;; var gifavi;; var logo;; var color=0xffcc00;; var playing=0;; var pausing=1;; var counter=0;; var counter0=0;; var countermax;; var filestart;; var filepnt;; var filepacket;; var wavchn;; var wavfreq;; var wavres;; var steplist;; var DVDTRONIC_STEPS= { 0 1 2 6 3 7 10 (-1) 4 8 11 (-1) 13 (-1) (-1) (-1) 5 9 12 (-1) 14 (-1) (-1) (-1) 15 (-1) (-1) (-1) (-1) (-1) (-1) (-1) };; fun mkstepdata2 l= if l!=nil then let hd l->[c s] in ((itoa c)::(itoh s)::nil)::mkstepdata2 tl l;; fun mkstepdata= wordbuild mkstepdata2 steplist;; fun parsestepdata2 l= if l!=nil then let hd l->(c::s::_) in [atoi c htoi s]::parsestepdata2 tl l;; fun parsestepdata src= set steplist=parsestepdata2 wordextr src;; fun filterstep c s tll= if s then [c s]::tll else tll;; fun addsteplist2 l count step_or step_and= if l==nil then (filterstep count step_or nil) else let hd l->[c0 s0] in if countintro then set steplist=addsteplist2 steplist count step (-1);; fun remsteplist count step= set steplist=addsteplist2 steplist count 0 (~step);; // display // ------- fun drawsteps2 l= if l!=nil then let hd l ->[count step] in if count=counter0+1500 then nil else let 20+(count-counter0)*2/5 -> x in let if DVDTRONIC_STEPS.step>=0 then #bitmapBoxF else #bitmapBox -> fundraw in ( if step&1 then call fundraw [bmp x-2 130 5 5 color]; if step&2 then call fundraw [bmp x-2 145 5 5 color]; if step&4 then call fundraw [bmp x-2 160 5 5 color]; if step&8 then call fundraw [bmp x-2 175 5 5 color]; if step&16 then call fundraw [bmp x-2 190 5 5 color]; drawsteps2 tl l );; fun drawsteps= drawsteps2 steplist;; fun drawplay dopaint= bitmapToBitmap bmp 300 274 (if pausing then gifplay else gifpause) 0 0 nil nil nil; if dopaint then bitmapToWindow win 300 274 bmp 300 274 21 21;; fun drawposition dopaint= bitmapText bmp 200 290 ALIGN_LEFT|ALIGN_BOTTOM strright strcat " " itoa counter 8 nil 0 color; if dopaint then bitmapToWindow win 200 275 bmp 200 275 150 25;; fun drawline dopaint= let 20+(counter-counter0)*2/5 -> x in ( bitmapLine bmp x 75 x 124 color; if counter>=intro && counter x in ( bitmapLine bmp x 75 x 124 0; if counter>=intro && counter=1000) then bitmapToBitmap bmp 5 274 gifleft 0 0 nil nil nil else bitmapBoxF bmp 20 126 intro*2/5 73 color; if (counter0+1000 x in bitmapBoxF bmp 20+x 126 600-x 73 color; drawposition 0; drawplay 0; bitmapToBitmap bmp 474 274 gifsave 0 0 nil nil nil; bitmapToBitmap bmp 574 274 gifavi 0 0 nil nil nil; bitmapToBitmap bmp 620-bitmapW logo 0 logo 0 0 nil nil nil; drawpoints 74; drawpoints 125; drawpoints 199; drawpoints 250; bitmapLine bmp 0 269 620 269 color; drawline 0; drawsteps; if dopaint then paint win; 0;; // gestion du wav fun soundclose= set playing=0; 0;; fun sounddata i= if pausing then ( soundPlayStop; nil ) else let fileRead filepnt filepacket -> s in ( if s==nil then ( soundPlayStop; set pausing=1; set counter0=0; set counter=0; fileSeek filepnt filestart; initbmp 1; nil ) else ( eraseline 0; set counter=counter+5; if (counter-counter0)*2/5>500 then ( set counter0=counter0+400*5/2; initbmp 1 ) else ( drawline 1; drawposition 1; nil ); s ) );; fun iniwav= let strcat file ".wav" -> wavfile in let soundWavInfo wavfile -> [ch freq res start size] in ( set wavchn=ch; set wavfreq=freq; set wavres=res; set filepacket=(ch*freq*res/8)/10; set countermax=5*((size+filepacket-1)/filepacket); set filestart=start; set filepnt=fileOpenR wavfile; fileSeek filepnt start; soundPlayCbData #sounddata; soundPlayCbClose #soundclose; set playing=0; set pausing=1; // soundPlayStart ch freq res 3 filepacket; 0 );; fun doleft= if counter0>=1000 then ( set counter0=counter0-1000; set counter=counter-1000; fileSeek filepnt filestart+filepacket*counter/5; initbmp 1 );; fun doright= if counter0+1000 xx in ( remsteplist xx-5 step; remsteplist xx step; remsteplist xx+5 step; initbmp 1 );; // gestion de la fenêtre fun click win x y button= if button==0 && y>75 && y<250 && x>20 then doseek x-20 else if button==1 then ( if y<130 then nil else if y<135 then tryerase x-20 1 else if y<145 then nil else if y<150 then tryerase x-20 2 else if y<160 then nil else if y<165 then tryerase x-20 4 else if y<175 then nil else if y<180 then tryerase x-20 8 else if y<190 then nil else if y<195 then tryerase x-20 16 );; fun unclick win x y button= if y>270 then if x<5 then nil else if x<26 then doleft else if x<31 then nil else if x<52 then doright else if x<300 then nil else if x<321 then doplay else if x<474 then nil else if x<495 then dosave else if x<574 then nil else if x<595 then domkavi else nil;; fun keydown win virt= if virt=='v' then addsteplist counter 1; if virt=='f' then addsteplist counter 2; if virt=='t' then addsteplist counter 4; if virt=='h' then addsteplist counter 8; if virt=='n' then addsteplist counter 16; if virt=='p' then doplay; if virt==XK_Left then doleft; if virt==XK_Right then doright; initbmp 1; 0;; fun paint w= bitmapToWindow w 0 0 bmp 0 0 nil nil; 0;; fun destroy win= exitandkill; 0;; fun main= set win=windowCreate 30 40 width height 0 "TranceMaker"; windowCbDestroy win #destroy; windowCbPaint win #paint; windowCbClick win #click; windowCbUnclick win #unclick; windowCbKeydown win #keydown; set bmp=bitmapCreate width height; set gifleft=bitmapFromFile "left.gif"; set gifright=bitmapFromFile "right.gif"; set gifplay=bitmapFromFile "play.gif"; set gifpause=bitmapFromFile "pause.gif"; set gifsave=bitmapFromFile "save.gif"; set gifavi=bitmapFromFile "avi.gif"; set logo=bitmapFromFile "logo_black_small.bmp"; parsestepdata load strcat file ".txt"; iniwav; initbmp 1; // echoCodec aviCodecs; 0;; // AVImaker // paramètres de l'application var flagtest=0;; // si 1 : pas de fichier avi, animation 5x plus rapide var width=768;; var height=576;; var codec="xvid";; var timedata=20;; // nombre de frames d'affichage d'une même trame var framerate=1;; // en 1/50 sec : 1 ou 2 // constantes d'encodage var DVDTRONIC_RESET=1;; var DVDTRONIC_ECHO =2;; var DVDTRONIC_DATA0=3;; var DVDTRONIC_DATA =4;; var DVDTRONIC_START=5;; var DVDTRONIC_MAGIC=0;; var DVDTRONIC_STEPS= { 0 1 2 6 3 7 10 (-1) 4 8 11 (-1) 13 (-1) (-1) (-1) 5 9 12 (-1) 14 (-1) (-1) (-1) 15 (-1) (-1) (-1) (-1) (-1) (-1) (-1) };; var DVDTRONIC_CODE="amberMind";; // fonctions standards fun conc p q=if p==nil then q else (hd p)::conc tl p q;; fun listHecho2 l= if l==nil then Secholn "nil" else (Secho strright strcat "0" itoh hd l 2;Secho ":";listHecho2 tl l);; fun listHecholn l=listHecho2 l; l;; // variables diverses var steps;; var win;; var bmp;; var avi;; var logo;; var audiopacket;; var audiofile;; var audioblank;; proto paint 1;; // affichage des trames var offsettop=2;; fun drawval val y h= let ((val&255)<<1)+0x200 -> v in let 0x200 -> msk in for i=0;i<10 do let (i+i)*width*11/229 -> i0 in let (i+i+1)*width*11/229 -> i1 in let (i+i+2)*width*11/229 -> i2 in ( bitmapBoxF bmp i0 y i1-i0 h if v&msk then 0xffffff else 0; bitmapBoxF bmp i1 y i2-i1 h if v&msk then 0 else 0xffffff; set v=v<<1 ); let 20*width*11/229 -> i0 in bitmapBoxF bmp i0 y width-i0 h 0xffffff ;; fun drawvals i offset l= let offset+i*5*600*height/198/768 -> i0 in let offset+(i+1)*5*600*height/198/768 -> i1 in if i0=(strlen DVDTRONIC_CODE)-1 then 0 else i+1;; fun addtramestep delay s l= if delay<16 then ((delay<<4)+s)::l else 0xf0::addtramestep delay-15 s l;; fun mktramesteps l base= if l!=nil then let hd l ->[delay pas] in let DVDTRONIC_STEPS.pas -> s in if s<0 then ( Secho "WARNING : wrong step : ";Secholn itoh pas; exit; nil ) else addtramestep (delay-base)/5 s mktramesteps tl l delay;; var indframe=0;; fun mktrame code l= set indframe=indframe+1; encode DVDTRONIC_MAGIC::((code<<4)+(indframe&15))::conc l 0::nil 0;; fun mktramesdata s code = if s!=nil && strlen s then (mktrame code strtolist strleft s nbdataperpage)::mktramesdata strsub s nbdataperpage nil DVDTRONIC_DATA;; fun mktrames l= let listtostr mktramesteps l intro -> s in conc mktramesdata s DVDTRONIC_DATA0 (mktrame DVDTRONIC_START nil)::nil;; // affichage des séquences de pas var pic;; var PIC_BACK=0;; var PIC_MOVE=64;; var PIC_DOIT=128;; fun drawpic n i= let (n+n+3)*width/14 -> x in if i k in bitmapStretch bmp x-k 102-k 2*k 2*k pic n*64 PIC_DOIT 64 64 0;; fun drawlpic l frame= if l!=nil then let hd l->[k f] in ( drawpic k frame-f; drawlpic tl l frame);; fun dopict l frame= bitmapErase bmp 0; bitmapToBitmap bmp width-100-bitmapW logo height-36-bitmapH logo logo 0 0 nil nil nil; for n=0;n<5 do let (n+n+3)*width/14 -> x in bitmapToBitmap bmp x-32 102-32 pic n*64 PIC_BACK 64 64 nil; drawlpic l frame;; fun addstep frame step k res= if k>=5 then res else if step&1 then addstep frame step>>1 k+1 [k frame]::res else addstep frame step>>1 k+1 res;; fun purgelpics l frame = if l!=nil then let hd l->[_ f0] in if frame-f0>intro+30 then purgelpics tl l frame else (hd l)::purgelpics tl l frame;; fun drawsteps = let nil -> lpics in let intro->frame in while frame[t step] in if t<=frame then ( set lpics=addstep frame step 0 lpics; set steps=tl steps ); dopict lpics frame; aviWriteVideo avi bmp; aviWriteAudio avi fileRead audiofile audiopacket; paint win; set frame=frame+framerate );; // gestion de la fenêtre fun paint w= bitmapToWindow w 0 0 bmp 0 0 nil nil; 0;; fun echoCodec l= if l!=nil then let hd l->[c v n d] in ( Secho c; Secho " (";Iecho v;Secho ") "; Secho n; Secho " : "; Secholn d; echoCodec tl l );; fun makeavi l file wavfile= set win=windowCreate 30 40 width height WINDOW_RESIZE "AVImaker"; windowCbPaint win #paint; set pic=bitmapFromFile "arrows.gif"; set logo=bitmapFromFile "logo_black_small.bmp"; set bmp=bitmapCreate width height; set steps=l; if !flagtest then set avi=aviCreate file codec width height 50/framerate 1 100 1500000; set audiopacket=wavchn*wavfreq*wavres*framerate/8/50; set audioblank=tabtostr newtab audiopacket 0; aviAddAudio avi wavchn wavfreq wavres; set audiofile=fileOpenR wavfile; fileSeek audiofile filestart; drawtrames mktrames steps; for i=0;i<15/framerate do aviWriteAudio avi audioblank; if flagtest || avi!=nil then drawsteps; aviClose avi; echoCodec aviCodecs; paint win; 0;;